Session HRB-Slicing

Theory AuxLemmas

section ‹Auxiliary lemmas›

theory AuxLemmas imports Main begin

text ‹Lemma concerning maps and @›

lemma map_append_append_maps:
  assumes map:"map f xs = ys@zs"
  obtains xs' xs'' where "map f xs' = ys" and "map f xs'' = zs" and "xs=xs'@xs''"
by (metis append_eq_conv_conj append_take_drop_id assms drop_map take_map that)


text ‹Lemma concerning splitting of @{term list}s›

lemma  path_split_general:
assumes all:"zs. xs  ys@zs"
obtains j zs where "xs = (take j ys)@zs" and "j < length ys"
  and "k > j. zs'. xs  (take k ys)@zs'"
proof(atomize_elim)
  from zs. xs  ys@zs
  show "j zs. xs = take j ys @ zs  j < length ys  
               (k>j. zs'. xs  take k ys @ zs')"
  proof(induct ys arbitrary:xs)
    case Nil thus ?case by auto
  next
    case (Cons y' ys')
    note IH = xs. zs. xs  ys' @ zs 
      j zs. xs = take j ys' @ zs  j < length ys'  
      (k. j < k  (zs'. xs  take k ys' @ zs'))
    show ?case
    proof(cases xs)
      case Nil thus ?thesis by simp
    next
      case (Cons x' xs')
      with zs. xs  (y' # ys') @ zs have "x'  y'  (zs. xs'  ys' @ zs)"
        by simp
      show ?thesis
      proof(cases "x' = y'")
        case True
        with x'  y'  (zs. xs'  ys' @ zs) have "zs. xs'  ys' @ zs" by simp
        from IH[OF this] have "j zs. xs' = take j ys' @ zs  j < length ys' 
          (k. j < k  (zs'. xs'  take k ys' @ zs'))" .
        then obtain j zs where "xs' = take j ys' @ zs"
          and "j < length ys'"
          and all_sub:"k. j < k  (zs'. xs'  take k ys' @ zs')"
          by blast
        from xs' = take j ys' @ zs True
          have "(x'#xs') = take (Suc j) (y' # ys') @ zs"
          by simp
        from all_sub True have all_imp:"k. j < k  
          (zs'. (x'#xs')  take (Suc k) (y' # ys') @ zs')"
          by auto
        { fix l assume "(Suc j) < l"
          then obtain k where [simp]:"l = Suc k" by(cases l) auto
          with (Suc j) < l have "j < k" by simp
          with all_imp 
          have "zs'. (x'#xs')  take (Suc k) (y' # ys') @ zs'"
            by simp
          hence "zs'. (x'#xs')  take l (y' # ys') @ zs'"
            by simp }
        with (x'#xs') = take (Suc j) (y' # ys') @ zs j < length ys' Cons
        show ?thesis by (metis Suc_length_conv less_Suc_eq_0_disj)
      next
        case False
        with Cons have "i zs'. i > 0  xs  take i (y' # ys') @ zs'"
          by auto(case_tac i,auto)
        moreover
        have "zs. xs = take 0 (y' # ys') @ zs" by simp
        ultimately show ?thesis by(rule_tac x="0" in exI,auto)
      qed
    qed
  qed
qed


end

Theory BasicDefs

chapter ‹The Framework›

theory BasicDefs imports AuxLemmas begin

text ‹
  As slicing is a program analysis that can be completely based on the
  information given in the CFG, we want to provide a framework which
  allows us to formalize and prove properties of slicing regardless of
  the actual programming language. So the starting point for the formalization 
  is the definition of an abstract CFG, i.e.\ without considering features 
  specific for certain languages. By doing so we ensure that our framework 
  is as generic as possible since all proofs hold for every language whose 
  CFG conforms to this abstract CFG.

  Static Slicing analyses a CFG prior to execution. Whereas dynamic
  slicing can provide better results for certain inputs (i.e.\ trace and
  initial state), static slicing is more conservative but provides
  results independent of inputs. 

  Correctness for static slicing is defined using a weak
  simulation between nodes and states when traversing the original and
  the sliced graph. The weak simulation property demands that if a
  (node,state) tuples $(n_1,s_1)$ simulates $(n_2,s_2)$
  and making an observable move in the original graph leads from 
  $(n_1,s_1)$ to $(n_1',s_1')$, this tuple simulates a 
  tuple $(n_2,s_2)$ which is the result of making an
  observable move in the sliced graph beginning in $(n_2',s_2')$.  
›

section ‹Basic Definitions›

fun fun_upds :: "('a  'b)  'a list  'b list  ('a  'b)"
where "fun_upds f [] ys = f"
  | "fun_upds f xs [] = f"
  | "fun_upds f (x#xs) (y#ys) = (fun_upds f xs ys)(x := y)"

notation fun_upds ("_'(_ /[:=]/ _')")

lemma fun_upds_nth:
  "i < length xs; length xs = length ys; distinct xs
   f(xs [:=] ys)(xs!i) = (ys!i)"
proof(induct xs arbitrary:ys i)
  case Nil thus ?case by simp
next
  case (Cons x' xs')
  note IH = ys i. i < length xs'; length xs' = length ys; distinct xs'
     f(xs' [:=] ys) (xs'!i) = ys!i
  from ‹distinct (x'#xs') have "distinct xs'" and "x'  set xs'" by simp_all
  from ‹length (x'#xs') = length ys obtain y' ys' where [simp]:"ys = y'#ys'"
    and "length xs' = length ys'"
    by(cases ys) auto
  show ?case
  proof(cases i)
    case 0 thus ?thesis by simp
  next
    case (Suc j)
    with i < length (x'#xs') have "j < length xs'" by simp
    from IH[OF this ‹length xs' = length ys' ‹distinct xs']
    have "f(xs' [:=] ys') (xs'!j) = ys'!j" .
    with x'  set xs' j < length xs'
    have "f((x'#xs') [:=] ys) ((x'#xs')!(Suc j)) = ys!(Suc j)" by fastforce
    with Suc show ?thesis by simp
  qed
qed


lemma fun_upds_eq:
  assumes "V  set xs" and "length xs = length ys" and "distinct xs"
  shows "f(xs [:=] ys) V = f'(xs [:=] ys) V"
proof -
  from V  set xs obtain i where "i < length xs" and "xs!i = V"
    by(fastforce simp:in_set_conv_nth)
  with ‹length xs = length ys ‹distinct xs
  have "f(xs [:=] ys)(xs!i) = (ys!i)" by -(rule fun_upds_nth)
  moreover
  from i < length xs xs!i = V ‹length xs = length ys ‹distinct xs
  have "f'(xs [:=] ys)(xs!i) = (ys!i)" by -(rule fun_upds_nth)
  ultimately show ?thesis using xs!i = V by simp
qed


lemma fun_upds_notin:"x  set xs  f(xs [:=] ys) x = f x"
by(induct xs arbitrary:ys,auto,case_tac ys,auto)


subsection distinct_fst›
 
definition distinct_fst :: "('a × 'b) list  bool" where
  "distinct_fst    distinct  map fst"

lemma distinct_fst_Nil [simp]:
  "distinct_fst []" 
  by(simp add:distinct_fst_def)

lemma distinct_fst_Cons [simp]:
  "distinct_fst ((k,x)#kxs) = (distinct_fst kxs  (y. (k,y)  set kxs))"
by(auto simp:distinct_fst_def image_def)


lemma distinct_fst_isin_same_fst:
  "(x,y)  set xs; (x,y')  set xs; distinct_fst xs
   y = y'"
by(induct xs,auto simp:distinct_fst_def image_def)


subsection‹Edge kinds›

text ‹Every procedure has a unique name, e.g. in object oriented languages
  pname› refers to class + procedure.›

text ‹A state is a call stack of tuples, which consists of:
  \begin{enumerate}
  \item data information, i.e.\ a mapping from the local variables in the call 
  frame to their values, and
  \item control flow information, e.g.\ which node called the current procedure.
  \end{enumerate}

  Update and predicate edges check and manipulate only the data information
  of the top call stack element. Call and return edges however may use the data and
  control flow information present in the top stack element to state if this edge is
  traversable. The call edge additionally has a list of functions to determine what
  values the parameters have in a certain call frame and control flow information for
  the return. The return edge is concerned with passing the values 
  of the return parameter values to the underlying stack frame. See the funtions 
  transfer› and pred› in locale CFG›.›

datatype (dead 'var, dead 'val, dead 'ret, dead 'pname) edge_kind =
    UpdateEdge "('var  'val)  ('var  'val)"                  ("_")
  | PredicateEdge "('var  'val)  bool"                         ("'(_')")
  | CallEdge "('var  'val) × 'ret  bool" "'ret" "'pname"  
             "(('var  'val)  'val) list"                       ("_:_↪⇘__" 70)
  | ReturnEdge "('var  'val) × 'ret  bool" "'pname" 
               "('var  'val)  ('var  'val)  ('var  'val)" ("_↩⇘__" 70)


definition intra_kind :: "('var,'val,'ret,'pname) edge_kind  bool"
where "intra_kind et  (f. et = f)  (Q. et = (Q))"


lemma edge_kind_cases [case_names Intra Call Return]:
  "intra_kind et  P; Q r p fs. et = Q:rpfs  P;
    Q p f. et = Qpf  P  P"
by(cases et,auto simp:intra_kind_def)


end

Theory CFG

section ‹CFG›

theory CFG imports BasicDefs begin

subsection ‹The abstract CFG›

subsubsection ‹Locale fixes and assumptions›

locale CFG =
  fixes sourcenode :: "'edge  'node"
  fixes targetnode :: "'edge  'node"
  fixes kind :: "'edge  ('var,'val,'ret,'pname) edge_kind"
  fixes valid_edge :: "'edge  bool"
  fixes Entry::"'node" ("'('_Entry'_')")
  fixes get_proc::"'node  'pname"
  fixes get_return_edges::"'edge  'edge set"
  fixes procs::"('pname × 'var list × 'var list) list"
  fixes Main::"'pname"
  assumes Entry_target [dest]: "valid_edge a; targetnode a = (_Entry_)  False"
  and get_proc_Entry:"get_proc (_Entry_) = Main"
  and Entry_no_call_source:
    "valid_edge a; kind a = Q:rpfs; sourcenode a = (_Entry_)  False"
  and edge_det: 
    "valid_edge a; valid_edge a'; sourcenode a = sourcenode a'; 
      targetnode a = targetnode a'  a = a'" 
  and Main_no_call_target:"valid_edge a; kind a = Q:rMainf  False" 
  and Main_no_return_source:"valid_edge a; kind a = Q'Mainf'  False" 
  and callee_in_procs: 
    "valid_edge a; kind a = Q:rpfs  ins outs. (p,ins,outs)  set procs" 
  and get_proc_intra:"valid_edge a; intra_kind(kind a)
     get_proc (sourcenode a) = get_proc (targetnode a)" 
  and get_proc_call:
    "valid_edge a; kind a = Q:rpfs  get_proc (targetnode a) = p"
  and get_proc_return:
    "valid_edge a; kind a = Q'pf'  get_proc (sourcenode a) = p"
  and call_edges_only:"valid_edge a; kind a = Q:rpfs 
     a'. valid_edge a'  targetnode a' = targetnode a  
            (Qx rx fsx. kind a' = Qx:rxpfsx)"
  and return_edges_only:"valid_edge a; kind a = Q'pf' 
     a'. valid_edge a'  sourcenode a' = sourcenode a  
            (Qx fx. kind a' = Qxpfx)" 
  and get_return_edge_call:
    "valid_edge a; kind a = Q:rpfs  get_return_edges a  {}" 
  and get_return_edges_valid:
    "valid_edge a; a'  get_return_edges a  valid_edge a'" 
  and only_call_get_return_edges:
    "valid_edge a; a'  get_return_edges a  Q r p fs. kind a = Q:rpfs" 
  and call_return_edges:
    "valid_edge a; kind a = Q:rpfs; a'  get_return_edges a 
     Q' f'. kind a' = Q'pf'" 
  and return_needs_call: "valid_edge a; kind a = Q'pf'
     ∃!a'. valid_edge a'  (Q r fs. kind a' = Q:rpfs)  a  get_return_edges a'"
  and intra_proc_additional_edge: 
    "valid_edge a; a'  get_return_edges a
     a''. valid_edge a''  sourcenode a'' = targetnode a  
              targetnode a'' = sourcenode a'  kind a'' = (λcf. False)"
  and call_return_node_edge: 
  "valid_edge a; a'  get_return_edges a
     a''. valid_edge a''  sourcenode a'' = sourcenode a  
             targetnode a'' = targetnode a'  kind a'' = (λcf. False)"
  and call_only_one_intra_edge:
    "valid_edge a; kind a = Q:rpfs 
     ∃!a'. valid_edge a'  sourcenode a' = sourcenode a  intra_kind(kind a')"
 and return_only_one_intra_edge:
    "valid_edge a; kind a = Q'pf' 
     ∃!a'. valid_edge a'  targetnode a' = targetnode a  intra_kind(kind a')"
  and same_proc_call_unique_target:
    "valid_edge a; valid_edge a'; kind a = Q1:r1pfs1;  kind a' = Q2:r2pfs2
     targetnode a = targetnode a'"
  and unique_callers:"distinct_fst procs" 
  and distinct_formal_ins:"(p,ins,outs)  set procs  distinct ins"
  and distinct_formal_outs:"(p,ins,outs)  set procs  distinct outs"

begin


lemma get_proc_get_return_edge:
  assumes "valid_edge a" and "a'  get_return_edges a"
  shows "get_proc (sourcenode a) = get_proc (targetnode a')"
proof -
  from assms obtain ax where "valid_edge ax" and "sourcenode a = sourcenode ax"
    and "targetnode a' = targetnode ax" and "intra_kind(kind ax)"
    by(auto dest:call_return_node_edge simp:intra_kind_def)
  thus ?thesis by(fastforce intro:get_proc_intra)
qed


lemma call_intra_edge_False:
  assumes "valid_edge a" and "kind a = Q:rpfs" and "valid_edge a'" 
  and "sourcenode a = sourcenode a'" and "intra_kind(kind a')"
  shows "kind a' = (λcf. False)"
proof -
  from valid_edge a kind a = Q:rpfs obtain ax where "ax  get_return_edges a"
    by(fastforce dest:get_return_edge_call)
  with valid_edge a obtain a'' where "valid_edge a''" 
    and "sourcenode a'' = sourcenode a" and "kind a'' = (λcf. False)"
    by(fastforce dest:call_return_node_edge)
  from kind a'' = (λcf. False) have "intra_kind(kind a'')" 
    by(simp add:intra_kind_def)
  with assms valid_edge a'' sourcenode a'' = sourcenode a 
    kind a'' = (λcf. False)
  show ?thesis by(fastforce dest:call_only_one_intra_edge)
qed


lemma formal_in_THE: 
  "valid_edge a; kind a = Q:rpfs; (p,ins,outs)  set procs
   (THE ins. outs. (p,ins,outs)  set procs) = ins"
by(fastforce dest:distinct_fst_isin_same_fst intro:unique_callers)

lemma formal_out_THE: 
  "valid_edge a; kind a = Qpf; (p,ins,outs)  set procs
   (THE outs. ins. (p,ins,outs)  set procs) = outs"
by(fastforce dest:distinct_fst_isin_same_fst intro:unique_callers)


subsubsection ‹Transfer and predicate functions›

fun params :: "(('var  'val)  'val) list  ('var  'val)  'val option list"
where "params [] cf = []"
  | "params (f#fs) cf = (f cf)#params fs cf"


lemma params_nth: 
  "i < length fs  (params fs cf)!i = (fs!i) cf"
by(induct fs arbitrary:i,auto,case_tac i,auto)


lemma [simp]:"length (params fs cf) = length fs"
  by(induct fs) auto


fun transfer :: "('var,'val,'ret,'pname) edge_kind  (('var  'val) × 'ret) list  
  (('var  'val) × 'ret) list"
where "transfer (f) (cf#cfs)    = (f (fst cf),snd cf)#cfs"
  | "transfer (Q) (cf#cfs)      = (cf#cfs)"
  | "transfer (Q:rpfs) (cf#cfs) = 
       (let ins = THE ins. outs. (p,ins,outs)  set procs in
                            (Map.empty(ins [:=] params fs (fst cf)),r)#cf#cfs)"
  | "transfer (Qpf )(cf#cfs)    = (case cfs of []  []
                                 | cf'#cfs'  (f (fst cf) (fst cf'),snd cf')#cfs')"
  | "transfer et [] = []"

fun transfers :: "('var,'val,'ret,'pname) edge_kind list  (('var  'val) × 'ret) list 
                  (('var  'val) × 'ret) list"
where "transfers [] s   = s"
  | "transfers (et#ets) s = transfers ets (transfer et s)"


fun pred :: "('var,'val,'ret,'pname) edge_kind  (('var  'val) × 'ret) list  bool"
where "pred (f) (cf#cfs) = True"
  | "pred (Q) (cf#cfs)   = Q (fst cf)"
  | "pred (Q:rpfs) (cf#cfs) = Q (fst cf,r)"
  | "pred (Qpf) (cf#cfs) = (Q cf  cfs  [])"
  | "pred et [] = False"

fun preds :: "('var,'val,'ret,'pname) edge_kind list  (('var  'val) × 'ret) list  bool"
where "preds [] s   = True"
  | "preds (et#ets) s = (pred et s  preds ets (transfer et s))"


lemma transfers_split:
  "(transfers (ets@ets') s) = (transfers ets' (transfers ets s))"
by(induct ets arbitrary:s) auto

lemma preds_split:
  "(preds (ets@ets') s) = (preds ets s  preds ets' (transfers ets s))"
by(induct ets arbitrary:s) auto


abbreviation state_val :: "(('var  'val) × 'ret) list  'var  'val"
  where "state_val s V  (fst (hd s)) V"


subsubsection valid_node›

definition valid_node :: "'node  bool"
  where "valid_node n  
  (a. valid_edge a  (n = sourcenode a  n = targetnode a))"

lemma [simp]: "valid_edge a  valid_node (sourcenode a)"
  by(fastforce simp:valid_node_def)

lemma [simp]: "valid_edge a  valid_node (targetnode a)"
  by(fastforce simp:valid_node_def)



subsection ‹CFG paths›

inductive path :: "'node  'edge list  'node  bool"
  ("_ -_→* _" [51,0,0] 80)
where 
  empty_path:"valid_node n  n -[]→* n"

  | Cons_path:
  "n'' -as→* n'; valid_edge a; sourcenode a = n; targetnode a = n''
     n -a#as→* n'"


lemma path_valid_node:
  assumes "n -as→* n'" shows "valid_node n" and "valid_node n'"
  using n -as→* n'
  by(induct rule:path.induct,auto)

lemma empty_path_nodes [dest]:"n -[]→* n'  n = n'"
  by(fastforce elim:path.cases)

lemma path_valid_edges:"n -as→* n'  a  set as. valid_edge a"
by(induct rule:path.induct) auto


lemma path_edge:"valid_edge a  sourcenode a -[a]→* targetnode a"
  by(fastforce intro:Cons_path empty_path)


lemma path_Append:"n -as→* n''; n'' -as'→* n' 
   n -as@as'→* n'"
by(induct rule:path.induct,auto intro:Cons_path)


lemma path_split:
  assumes "n -as@a#as'→* n'"
  shows "n -as→* sourcenode a" and "valid_edge a" and "targetnode a -as'→* n'"
  using n -as@a#as'→* n'
proof(induct as arbitrary:n)
  case Nil case 1
  thus ?case by(fastforce elim:path.cases intro:empty_path)
next
  case Nil case 2
  thus ?case by(fastforce elim:path.cases intro:path_edge)
next
  case Nil case 3
  thus ?case by(fastforce elim:path.cases)
next
  case (Cons ax asx) 
  note IH1 = n. n -asx@a#as'→* n'  n -asx→* sourcenode a
  note IH2 = n. n -asx@a#as'→* n'  valid_edge a
  note IH3 = n. n -asx@a#as'→* n'  targetnode a -as'→* n'
  { case 1 
    hence "sourcenode ax = n" and "targetnode ax -asx@a#as'→* n'" and "valid_edge ax"
      by(auto elim:path.cases)
    from IH1[OF targetnode ax -asx@a#as'→* n'] 
    have "targetnode ax -asx→* sourcenode a" .
    with sourcenode ax = n valid_edge ax show ?case by(fastforce intro:Cons_path)
  next
    case 2 hence "targetnode ax -asx@a#as'→* n'" by(auto elim:path.cases)
    from IH2[OF this] show ?case .
  next
    case 3 hence "targetnode ax -asx@a#as'→* n'" by(auto elim:path.cases)
    from IH3[OF this] show ?case .
  }
qed


lemma path_split_Cons:
  assumes "n -as→* n'" and "as  []"
  obtains a' as' where "as = a'#as'" and "n = sourcenode a'"
  and "valid_edge a'" and "targetnode a' -as'→* n'"
proof(atomize_elim)
  from as  [] obtain a' as' where "as = a'#as'" by(cases as) auto
  with n -as→* n' have "n -[]@a'#as'→* n'" by simp
  hence "n -[]→* sourcenode a'" and "valid_edge a'" and "targetnode a' -as'→* n'"
    by(rule path_split)+
  from n -[]→* sourcenode a' have "n = sourcenode a'" by fast
  with as = a'#as' valid_edge a' targetnode a' -as'→* n'
  show "a' as'. as = a'#as'  n = sourcenode a'  valid_edge a'  
                 targetnode a' -as'→* n'"
    by fastforce
qed


lemma path_split_snoc:
  assumes "n -as→* n'" and "as  []"
  obtains a' as' where "as = as'@[a']" and "n -as'→* sourcenode a'"
  and "valid_edge a'" and "n' = targetnode a'"
proof(atomize_elim)
  from as  [] obtain a' as' where "as = as'@[a']" by(cases as rule:rev_cases) auto
  with n -as→* n' have "n -as'@a'#[]→* n'" by simp
  hence "n -as'→* sourcenode a'" and "valid_edge a'" and "targetnode a' -[]→* n'"
    by(rule path_split)+
  from targetnode a' -[]→* n' have "n' = targetnode a'" by fast
  with as = as'@[a'] valid_edge a' n -as'→* sourcenode a'
  show "as' a'. as = as'@[a']  n -as'→* sourcenode a'  valid_edge a'  
                 n' = targetnode a'"
    by fastforce
qed


lemma path_split_second:
  assumes "n -as@a#as'→* n'" shows "sourcenode a -a#as'→* n'"
proof -
  from n -as@a#as'→* n' have "valid_edge a" and "targetnode a -as'→* n'"
    by(auto intro:path_split)
  thus ?thesis by(fastforce intro:Cons_path)
qed


lemma path_Entry_Cons:
  assumes "(_Entry_) -as→* n'" and "n'  (_Entry_)"
  obtains n a where "sourcenode a = (_Entry_)" and "targetnode a = n"
  and "n -tl as→* n'" and "valid_edge a" and "a = hd as"
proof(atomize_elim)
  from (_Entry_) -as→* n' n'  (_Entry_) have "as  []"
    by(cases as,auto elim:path.cases)
  with (_Entry_) -as→* n' obtain a' as' where "as = a'#as'" 
    and "(_Entry_) = sourcenode a'" and "valid_edge a'" and "targetnode a' -as'→* n'"
    by(erule path_split_Cons)
  thus "a n. sourcenode a = (_Entry_)  targetnode a = n  n -tl as→* n'  
              valid_edge a  a = hd as"
  by fastforce
qed


lemma path_det:
  "n -as→* n'; n -as→* n''  n' = n''"
proof(induct as arbitrary:n)
  case Nil thus ?case by(auto elim:path.cases)
next
  case (Cons a' as')
  note IH = n. n -as'→* n'; n -as'→* n''  n' = n''
  from n -a'#as'→* n' have "targetnode a' -as'→* n'" 
    by(fastforce elim:path_split_Cons)
  from n -a'#as'→* n'' have "targetnode a' -as'→* n''" 
    by(fastforce elim:path_split_Cons)
  from IH[OF targetnode a' -as'→* n' this] show ?thesis .
qed


definition
  sourcenodes :: "'edge list  'node list"
  where "sourcenodes xs  map sourcenode xs"

definition
  kinds :: "'edge list  ('var,'val,'ret,'pname) edge_kind list"
  where "kinds xs  map kind xs"

definition
  targetnodes :: "'edge list  'node list"
  where "targetnodes xs  map targetnode xs"


lemma path_sourcenode:
  "n -as→* n'; as  []  hd (sourcenodes as) = n"
by(fastforce elim:path_split_Cons simp:sourcenodes_def)



lemma path_targetnode:
  "n -as→* n'; as  []  last (targetnodes as) = n'"
by(fastforce elim:path_split_snoc simp:targetnodes_def)



lemma sourcenodes_is_n_Cons_butlast_targetnodes:
  "n -as→* n'; as  []  
  sourcenodes as = n#(butlast (targetnodes as))"
proof(induct as arbitrary:n)
  case Nil thus ?case by simp
next
  case (Cons a' as')
  note IH = n. n -as'→* n'; as'  []
             sourcenodes as' = n#(butlast (targetnodes as'))
  from n -a'#as'→* n' have "n = sourcenode a'" and "targetnode a' -as'→* n'"
    by(auto elim:path_split_Cons)
  show ?case
  proof(cases "as' = []")
    case True
    with targetnode a' -as'→* n' have "targetnode a' = n'" by fast
    with True n = sourcenode a' show ?thesis
      by(simp add:sourcenodes_def targetnodes_def)
  next
    case False
    from IH[OF targetnode a' -as'→* n' this] 
    have "sourcenodes as' = targetnode a' # butlast (targetnodes as')" .
    with n = sourcenode a' False show ?thesis
      by(simp add:sourcenodes_def targetnodes_def)
  qed
qed



lemma targetnodes_is_tl_sourcenodes_App_n':
  "n -as→* n'; as  []  
    targetnodes as = (tl (sourcenodes as))@[n']"
proof(induct as arbitrary:n' rule:rev_induct)
  case Nil thus ?case by simp
next
  case (snoc a' as')
  note IH = n'. n -as'→* n'; as'  []
     targetnodes as' = tl (sourcenodes as') @ [n']
  from n -as'@[a']→* n' have "n -as'→* sourcenode a'" and "n' = targetnode a'"
    by(auto elim:path_split_snoc)
  show ?case
  proof(cases "as' = []")
    case True
    with n -as'→* sourcenode a' have "n = sourcenode a'" by fast
    with True n' = targetnode a' show ?thesis
      by(simp add:sourcenodes_def targetnodes_def)
  next
    case False
    from IH[OF n -as'→* sourcenode a' this]
    have "targetnodes as' = tl (sourcenodes as')@[sourcenode a']" .
    with n' = targetnode a' False show ?thesis
      by(simp add:sourcenodes_def targetnodes_def)
  qed
qed


subsubsection ‹Intraprocedural paths›

definition intra_path :: "'node  'edge list  'node  bool" 
  ("_ -_ι* _" [51,0,0] 80)
where "n -asι* n'  n -as→* n'  (a  set as. intra_kind(kind a))"

lemma intra_path_get_procs:
  assumes "n -asι* n'" shows "get_proc n = get_proc n'"
proof -
  from n -asι* n' have "n -as→* n'" and "a  set as. intra_kind(kind a)"
    by(simp_all add:intra_path_def)
  thus ?thesis
  proof(induct as arbitrary:n)
    case Nil thus ?case by fastforce
  next
    case (Cons a' as')
    note IH = n. n -as'→* n'; aset as'. intra_kind (kind a)
       get_proc n = get_proc n'
    from aset (a'#as'). intra_kind (kind a)
    have "intra_kind(kind a')" and "aset as'. intra_kind (kind a)" by simp_all
    from n -a'#as'→* n' have "sourcenode a' = n" and "valid_edge a'"
      and "targetnode a' -as'→* n'" by(auto elim:path.cases)
    from IH[OF targetnode a' -as'→* n' aset as'. intra_kind (kind a)]
    have "get_proc (targetnode a') = get_proc n'" .
    from valid_edge a' ‹intra_kind(kind a') 
    have "get_proc (sourcenode a') = get_proc (targetnode a')"
      by(rule get_proc_intra)
    with sourcenode a' = n get_proc (targetnode a') = get_proc n'
    show ?case by simp
  qed
qed


lemma intra_path_Append:
  "n -asι* n''; n'' -as'ι* n'  n -as@as'ι* n'"
by(fastforce intro:path_Append simp:intra_path_def)


lemma get_proc_get_return_edges: 
  assumes "valid_edge a" and "a'  get_return_edges a"
  shows "get_proc(targetnode a) = get_proc(sourcenode a')"
proof -
  from valid_edge a a'  get_return_edges a
  obtain a'' where "valid_edge a''" and "sourcenode a'' = targetnode a"
    and "targetnode a'' = sourcenode a'" and "kind a'' = (λcf. False)"
    by(fastforce dest:intra_proc_additional_edge)
  from valid_edge a'' kind a'' = (λcf. False)
  have "get_proc(sourcenode a'') = get_proc(targetnode a'')"
    by(fastforce intro:get_proc_intra simp:intra_kind_def)
  with sourcenode a'' = targetnode a targetnode a'' = sourcenode a'
  show ?thesis by simp
qed


subsubsection ‹Valid paths›

declare conj_cong[fundef_cong]

fun valid_path_aux :: "'edge list  'edge list  bool"
  where "valid_path_aux cs []  True"
  | "valid_path_aux cs (a#as)  
       (case (kind a) of Q:rpfs  valid_path_aux (a#cs) as
                       | Qpf  case cs of []  valid_path_aux [] as
                                     | c'#cs'  a  get_return_edges c' 
                                                 valid_path_aux cs' as
                       |    _  valid_path_aux cs as)"


lemma vpa_induct [consumes 1,case_names vpa_empty vpa_intra vpa_Call vpa_ReturnEmpty
  vpa_ReturnCons]:
  assumes major: "valid_path_aux xs ys"
  and rules: "cs. P cs []"
    "cs a as. intra_kind(kind a); valid_path_aux cs as; P cs as  P cs (a#as)"
    "cs a as Q r p fs. kind a = Q:rpfs; valid_path_aux (a#cs) as; P (a#cs) as 
       P cs (a#as)"
    "cs a as Q p f. kind a = Qpf; cs = []; valid_path_aux [] as; P [] as 
       P cs (a#as)"
    "cs a as Q p f c' cs' . kind a = Qpf; cs = c'#cs'; valid_path_aux cs' as;
                              a  get_return_edges c'; P cs' as
      P cs (a#as)"
  shows "P xs ys"
using major
apply(induct ys arbitrary: xs)
by(auto intro:rules split:edge_kind.split_asm list.split_asm simp:intra_kind_def)


lemma valid_path_aux_intra_path:
  "a  set as. intra_kind(kind a)  valid_path_aux cs as"
by(induct as,auto simp:intra_kind_def)


lemma valid_path_aux_callstack_prefix:
  "valid_path_aux (cs@cs') as  valid_path_aux cs as"
proof(induct "cs@cs'" as arbitrary:cs cs' rule:vpa_induct)
  case vpa_empty thus ?case by simp
next
  case (vpa_intra a as)
  hence "valid_path_aux cs as" by simp
  with ‹intra_kind (kind a) show ?case by(cases "kind a",auto simp:intra_kind_def)
next
  case (vpa_Call a as Q r p fs cs'' cs')
  note IH = xs ys. a#cs''@cs' = xs@ys  valid_path_aux xs as
  have "a#cs''@cs' = (a#cs'')@cs'" by simp
  from IH[OF this] have "valid_path_aux (a#cs'') as" .
  with kind a = Q:rpfs show ?case by simp
next
  case (vpa_ReturnEmpty a as Q p f cs'' cs')
  hence "valid_path_aux cs'' as" by simp
  with kind a = Qpf cs''@cs' = [] show ?case by simp
next
  case (vpa_ReturnCons a as Q p f c' cs' csx csx')
  note IH = xs ys. cs' = xs@ys  valid_path_aux xs as
  from csx@csx' = c'#cs' 
  have "csx = []  csx' = c'#cs'  (zs. csx = c'#zs  zs@csx' = cs')"
    by(simp add:append_eq_Cons_conv)
  thus ?case
  proof
    assume "csx = []  csx' = c'#cs'"
    hence "csx = []" and "csx' = c'#cs'" by simp_all
    from csx' = c'#cs' have "cs' = []@tl csx'" by simp
    from IH[OF this] have "valid_path_aux [] as" .
    with csx = [] kind a = Qpf show ?thesis by simp
  next
    assume "zs. csx = c'#zs  zs@csx' = cs'"
    then obtain zs where "csx = c'#zs" and "cs' = zs@csx'" by auto
    from IH[OF cs' = zs@csx'] have "valid_path_aux zs as" .
    with csx = c'#zs kind a = Qpf a  get_return_edges c' 
    show ?thesis by simp
  qed
qed


fun upd_cs :: "'edge list  'edge list  'edge list"
  where "upd_cs cs [] = cs"
  | "upd_cs cs (a#as) =
       (case (kind a) of Q:rpfs  upd_cs (a#cs) as
                       | Qpf  case cs of []  upd_cs cs as
                                      | c'#cs'  upd_cs cs' as
                       |    _  upd_cs cs as)"


lemma upd_cs_empty [dest]:
  "upd_cs cs [] = []  cs = []"
by(cases cs) auto


lemma upd_cs_intra_path:
  "a  set as. intra_kind(kind a)  upd_cs cs as = cs"
by(induct as,auto simp:intra_kind_def)


lemma upd_cs_Append:
  "upd_cs cs as = cs'; upd_cs cs' as' = cs''  upd_cs cs (as@as') = cs''"
by(induct as arbitrary:cs,auto split:edge_kind.split list.split)


lemma upd_cs_empty_split:
  assumes "upd_cs cs as = []" and "cs  []" and "as  []"
  obtains xs ys where "as = xs@ys" and "xs  []" and "upd_cs cs xs = []"
  and "xs' ys'. xs = xs'@ys'  ys'  []  upd_cs cs xs'  []"
  and "upd_cs [] ys = []"
proof(atomize_elim)
  from ‹upd_cs cs as = [] cs  [] as  []
  show "xs ys. as = xs@ys  xs  []  upd_cs cs xs = []  
             (xs' ys'. xs = xs'@ys'  ys'  []  upd_cs cs xs'  [])  
             upd_cs [] ys = []"
  proof(induct as arbitrary:cs)
    case Nil thus ?case by simp
  next
    case (Cons a' as')
    note IH = cs. upd_cs cs as' = []; cs  []; as'  []
       xs ys. as' = xs@ys  xs  []  upd_cs cs xs = [] 
                 (xs' ys'. xs = xs'@ys'  ys'  []  upd_cs cs xs'  [])  
                 upd_cs [] ys = []
    show ?case
    proof(cases "kind a'" rule:edge_kind_cases)
      case Intra
      with ‹upd_cs cs (a'#as') = [] have "upd_cs cs as' = []"
        by(fastforce simp:intra_kind_def)
      with cs  [] have "as'  []" by fastforce
      from IH[OF ‹upd_cs cs as' = [] cs  [] this] obtain xs ys where "as' = xs@ys"
        and "xs  []" and "upd_cs cs xs = []" and "upd_cs [] ys = []"
        and "xs' ys'. xs = xs'@ys'  ys'  []  upd_cs cs xs'  []" by blast
      from ‹upd_cs cs xs = [] Intra have "upd_cs cs (a'#xs) = []"
        by(fastforce simp:intra_kind_def)
      from xs' ys'. xs = xs'@ys'  ys'  []  upd_cs cs xs'  [] xs  [] Intra
      have "xs' ys'. a'#xs = xs'@ys'  ys'  []  upd_cs cs xs'  []"
        apply auto
        apply(case_tac xs') apply(auto simp:intra_kind_def)
        by(erule_tac x="[]" in allE,fastforce)+
      with as' = xs@ys ‹upd_cs cs (a'#xs) = [] ‹upd_cs [] ys = []
      show ?thesis apply(rule_tac x="a'#xs" in exI) by fastforce
    next
      case (Call Q p f)
      with ‹upd_cs cs (a'#as') = [] have "upd_cs (a'#cs) as' = []" by simp
      with cs  [] have "as'  []" by fastforce
      from IH[OF ‹upd_cs (a'#cs) as' = [] _ this] obtain xs ys where "as' = xs@ys"
        and "xs  []" and "upd_cs (a'#cs) xs = []" and "upd_cs [] ys = []"
        and "xs' ys'. xs = xs'@ys'  ys'  []  upd_cs (a'#cs) xs'  []" by blast
      from ‹upd_cs (a'#cs) xs = [] Call have "upd_cs cs (a'#xs) = []" by simp
      from xs' ys'. xs = xs'@ys'  ys'  []  upd_cs (a'#cs) xs'  [] 
        xs  [] cs  [] Call
      have "xs' ys'. a'#xs = xs'@ys'  ys'  []  upd_cs cs xs'  []"
        by auto(case_tac xs',auto)
      with as' = xs@ys ‹upd_cs cs (a'#xs) = [] ‹upd_cs [] ys = []
      show ?thesis apply(rule_tac x="a'#xs" in exI) by fastforce
    next
      case (Return Q p f)
      with ‹upd_cs cs (a'#as') = [] cs  [] obtain c' cs' where "cs = c'#cs'"
        and "upd_cs cs' as' = []" by(cases cs) auto
      show ?thesis
      proof(cases "cs' = []")
        case True
        with cs = c'#cs' ‹upd_cs cs' as' = [] Return show ?thesis
          apply(rule_tac x="[a']" in exI) apply clarsimp
          by(case_tac xs') auto
      next
        case False
        with ‹upd_cs cs' as' = [] have "as'  []" by fastforce
        from IH[OF ‹upd_cs cs' as' = [] False this] obtain xs ys where "as' = xs@ys"
          and "xs  []" and "upd_cs cs' xs = []" and "upd_cs [] ys = []"
          and "xs' ys'. xs = xs'@ys'  ys'  []  upd_cs cs' xs'  []" by blast
        from ‹upd_cs cs' xs = [] cs = c'#cs' Return have "upd_cs cs (a'#xs) = []"
          by simp
        from xs' ys'. xs = xs'@ys'  ys'  []  upd_cs cs' xs'  []
          xs  [] cs = c'#cs' Return
        have "xs' ys'. a'#xs = xs'@ys'  ys'  []  upd_cs cs xs'  []"
          by auto(case_tac xs',auto)
        with as' = xs@ys ‹upd_cs cs (a'#xs) = [] ‹upd_cs [] ys = []
        show ?thesis apply(rule_tac x="a'#xs" in exI) by fastforce
      qed
    qed
  qed
qed


lemma upd_cs_snoc_Return_Cons:
  assumes "kind a = Qpf"
  shows "upd_cs cs as = c'#cs'  upd_cs cs (as@[a]) = cs'"
proof(induct as arbitrary:cs)
  case Nil
  with kind a = Qpf have "upd_cs cs [a] = cs'" by simp
 thus ?case by simp
next
  case (Cons a' as')
  note IH = cs. upd_cs cs as' = c'#cs'  upd_cs cs (as'@[a]) = cs'
  show ?case
  proof(cases "kind a'" rule:edge_kind_cases)
    case Intra
    with ‹upd_cs cs (a'#as') = c'#cs'
    have "upd_cs cs as' = c'#cs'" by(fastforce simp:intra_kind_def)
    from IH[OF this] have "upd_cs cs (as'@[a]) = cs'" .
    with Intra show ?thesis by(fastforce simp:intra_kind_def)
  next
    case Call
    with ‹upd_cs cs (a'#as') = c'#cs'
    have "upd_cs (a'#cs) as' = c'#cs'" by simp
    from IH[OF this] have "upd_cs (a'#cs) (as'@[a]) = cs'" .
    with Call show ?thesis by simp
  next
    case Return
    show ?thesis
    proof(cases cs)
      case Nil
      with ‹upd_cs cs (a'#as') = c'#cs' Return
      have "upd_cs cs as' = c'#cs'" by simp
      from IH[OF this] have "upd_cs cs (as'@[a]) = cs'" .
      with Nil Return show ?thesis by simp
    next
      case (Cons cx csx)
      with ‹upd_cs cs (a'#as') = c'#cs' Return
      have "upd_cs csx as' = c'#cs'" by simp
      from IH[OF this] have "upd_cs csx (as'@[a]) = cs'" .
      with Cons Return show ?thesis by simp
    qed
  qed
qed


lemma upd_cs_snoc_Call:
  assumes "kind a = Q:rpfs"
  shows "upd_cs cs (as@[a]) = a#(upd_cs cs as)"
proof(induct as arbitrary:cs)
  case Nil
  with kind a = Q:rpfs show ?case by simp
next
  case (Cons a' as')
  note IH = cs. upd_cs cs (as'@[a]) = a#upd_cs cs as'
  show ?case
  proof(cases "kind a'" rule:edge_kind_cases)
    case Intra 
    with IH[of cs] show ?thesis by(fastforce simp:intra_kind_def)
  next
    case Call
    with IH[of "a'#cs"] show ?thesis by simp
  next
    case Return
    show ?thesis
    proof(cases cs)
      case Nil
      with IH[of "[]"] Return show ?thesis by simp
    next
      case (Cons cx csx)
      with IH[of csx] Return show ?thesis by simp
    qed
  qed
qed





lemma valid_path_aux_split:
  assumes "valid_path_aux cs (as@as')"
  shows "valid_path_aux cs as" and "valid_path_aux (upd_cs cs as) as'"
  using ‹valid_path_aux cs (as@as')
proof(induct cs "as@as'" arbitrary:as as' rule:vpa_induct)
  case (vpa_intra cs a as as'')
  note IH1 = xs ys. as = xs@ys  valid_path_aux cs xs
  note IH2 = xs ys. as = xs@ys  valid_path_aux (upd_cs cs xs) ys
  { case 1
    from vpa_intra
    have "as'' = []  a#as = as'  (xs. a#xs = as''  as = xs@as')"
      by(simp add:Cons_eq_append_conv)
    thus ?case
    proof
      assume "as'' = []  a#as = as'"
      thus ?thesis by simp
    next
      assume "xs. a#xs = as''  as = xs@as'"
      then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
      from IH1[OF as = xs@as'] have "valid_path_aux cs xs" .
      with a#xs = as'' ‹intra_kind (kind a)
      show ?thesis by(fastforce simp:intra_kind_def)
    qed
  next
    case 2
    from vpa_intra
    have "as'' = []  a#as = as'  (xs. a#xs = as''  as = xs@as')"
      by(simp add:Cons_eq_append_conv)
    thus ?case
    proof
      assume "as'' = []  a#as = as'"
      hence "as = []@tl as'" by(cases as') auto
      from IH2[OF this] have "valid_path_aux (upd_cs cs []) (tl as')" by simp
      with as'' = []  a#as = as' ‹intra_kind (kind a)
      show ?thesis by(fastforce simp:intra_kind_def)
    next
      assume "xs. a#xs = as''  as = xs@as'"
      then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
      from IH2[OF as = xs@as'] have "valid_path_aux (upd_cs cs xs) as'" .
      from a#xs = as'' ‹intra_kind (kind a) 
      have "upd_cs cs xs = upd_cs cs as''" by(fastforce simp:intra_kind_def)
      with ‹valid_path_aux (upd_cs cs xs) as'
      show ?thesis by simp
    qed
  }
next
  case (vpa_Call cs a as Q r p fs as'')
  note IH1 = xs ys. as = xs@ys  valid_path_aux (a#cs) xs
  note IH2 = xs ys. as = xs@ys    valid_path_aux (upd_cs (a#cs) xs) ys
  { case 1
    from vpa_Call
    have "as'' = []  a#as = as'  (xs. a#xs = as''  as = xs@as')"
      by(simp add:Cons_eq_append_conv)
    thus ?case
    proof
      assume "as'' = []  a#as = as'"
      thus ?thesis by simp
    next
      assume "xs. a#xs = as''  as = xs@as'"
      then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
      from IH1[OF as = xs@as'] have "valid_path_aux (a#cs) xs" .
      with a#xs = as''[THEN sym] kind a = Q:rpfs
      show ?thesis by simp
    qed
  next
    case 2
    from vpa_Call
    have "as'' = []  a#as = as'  (xs. a#xs = as''  as = xs@as')"
      by(simp add:Cons_eq_append_conv)
    thus ?case
    proof
      assume "as'' = []  a#as = as'"
      hence "as = []@tl as'" by(cases as') auto
      from IH2[OF this] have "valid_path_aux (upd_cs (a#cs) []) (tl as')" .
      with as'' = []  a#as = as' kind a = Q:rpfs
      show ?thesis by clarsimp
    next
      assume "xs. a#xs = as''  as = xs@as'"
      then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
      from IH2[OF as = xs@as'] have "valid_path_aux (upd_cs (a # cs) xs) as'" .
      with a#xs = as''[THEN sym]  kind a = Q:rpfs
      show ?thesis by simp
    qed
  }
next
  case (vpa_ReturnEmpty cs a as Q p f as'')
  note IH1 = xs ys. as = xs@ys  valid_path_aux [] xs
  note IH2 = xs ys. as = xs@ys  valid_path_aux (upd_cs [] xs) ys
  { case 1
    from vpa_ReturnEmpty
    have "as'' = []  a#as = as'  (xs. a#xs = as''  as = xs@as')"
      by(simp add:Cons_eq_append_conv)
    thus ?case
    proof
      assume "as'' = []  a#as = as'"
      thus ?thesis by simp
    next
      assume "xs. a#xs = as''  as = xs@as'"
      then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
      from IH1[OF as = xs@as'] have "valid_path_aux [] xs" .
      with a#xs = as''[THEN sym] kind a = Qpf cs = []
      show ?thesis by simp
    qed
  next
    case 2
    from vpa_ReturnEmpty
    have "as'' = []  a#as = as'  (xs. a#xs = as''  as = xs@as')"
      by(simp add:Cons_eq_append_conv)
    thus ?case
    proof
      assume "as'' = []  a#as = as'"
      hence "as = []@tl as'" by(cases as') auto
      from IH2[OF this] have "valid_path_aux [] (tl as')" by simp
      with as'' = []  a#as = as' kind a = Qpf cs = []
      show ?thesis by fastforce
    next
      assume "xs. a#xs = as''  as = xs@as'"
      then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
      from IH2[OF as = xs@as'] have "valid_path_aux (upd_cs [] xs) as'" .
      from a#xs = as''[THEN sym] kind a = Qpf cs = []
      have "upd_cs [] xs = upd_cs cs as''" by simp
      with ‹valid_path_aux (upd_cs [] xs) as' show ?thesis by simp
    qed
  }
next
  case (vpa_ReturnCons cs a as Q p f c' cs' as'')
  note IH1 = xs ys. as = xs@ys  valid_path_aux cs' xs
  note IH2 = xs ys. as = xs@ys  valid_path_aux (upd_cs cs' xs) ys
  { case 1
    from vpa_ReturnCons
    have "as'' = []  a#as = as'  (xs. a#xs = as''  as = xs@as')"
      by(simp add:Cons_eq_append_conv)
    thus ?case
    proof
      assume "as'' = []  a#as = as'"
      thus ?thesis by simp
    next
       assume "xs. a#xs = as''  as = xs@as'"
       then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
       from IH1[OF as = xs@as'] have "valid_path_aux cs' xs" .
       with a#xs = as''[THEN sym] kind a = Qpf cs = c'#cs'
         a  get_return_edges c'
       show ?thesis by simp
     qed
   next
     case 2
     from vpa_ReturnCons
     have "as'' = []  a#as = as'  (xs. a#xs = as''  as = xs@as')"
      by(simp add:Cons_eq_append_conv)
    thus ?case
    proof
      assume "as'' = []  a#as = as'"
      hence "as = []@tl as'" by(cases as') auto
      from IH2[OF this] have "valid_path_aux (upd_cs cs' []) (tl as')" .
       with as'' = []  a#as = as' kind a = Qpf cs = c'#cs'
         a  get_return_edges c'
       show ?thesis by fastforce
    next
      assume "xs. a#xs = as''  as = xs@as'"
      then obtain xs where "a#xs = as''" and "as = xs@as'" by auto
      from IH2[OF as = xs@as'] have "valid_path_aux (upd_cs cs' xs) as'" .
      from a#xs = as''[THEN sym] kind a = Qpf cs = c'#cs'
      have "upd_cs cs' xs = upd_cs cs as''" by simp
      with ‹valid_path_aux (upd_cs cs' xs) as' show ?thesis by simp
    qed
  }
qed simp_all


lemma valid_path_aux_Append:
  "valid_path_aux cs as; valid_path_aux (upd_cs cs as) as'
   valid_path_aux cs (as@as')"
by(induct rule:vpa_induct,auto simp:intra_kind_def)


lemma vpa_snoc_Call:
  assumes "kind a = Q:rpfs"
  shows "valid_path_aux cs as  valid_path_aux cs (as@[a])"
proof(induct rule:vpa_induct)
  case (vpa_empty cs)
  from kind a = Q:rpfs have "valid_path_aux cs [a]" by simp
  thus ?case by simp
next
  case (vpa_intra cs a' as')
  from ‹valid_path_aux cs (as'@[a]) ‹intra_kind (kind a')
  have "valid_path_aux cs (a'#(as'@[a]))"
    by(fastforce simp:intra_kind_def)
  thus ?case by simp
next
  case (vpa_Call cs a' as' Q' r' p' fs')
  from ‹valid_path_aux (a'#cs) (as'@[a]) kind a' = Q':r'p'fs'
  have "valid_path_aux cs (a'#(as'@[a]))" by simp
  thus ?case by simp
next
  case (vpa_ReturnEmpty cs a' as' Q' p' f')
  from ‹valid_path_aux [] (as'@[a]) kind a' = Q'p'f' cs = []
  have "valid_path_aux cs (a'#(as'@[a]))" by simp
  thus ?case by simp
next
  case (vpa_ReturnCons cs a' as' Q' p' f' c' cs')
  from ‹valid_path_aux cs' (as'@[a]) kind a' = Q'p'f' cs = c'#cs'
    a'  get_return_edges c'
  have "valid_path_aux cs (a'#(as'@[a]))" by simp
  thus ?case by simp
qed



definition valid_path :: "'edge list  bool"
  where "valid_path as  valid_path_aux [] as"


lemma valid_path_aux_valid_path:
  "valid_path_aux cs as  valid_path as"
by(fastforce intro:valid_path_aux_callstack_prefix simp:valid_path_def)

lemma valid_path_split:
  assumes "valid_path (as@as')" shows "valid_path as" and "valid_path as'"
  using ‹valid_path (as@as')
  apply(auto simp:valid_path_def)
   apply(erule valid_path_aux_split)
  apply(drule valid_path_aux_split(2))
  by(fastforce intro:valid_path_aux_callstack_prefix)



definition valid_path' :: "'node  'edge list  'node  bool"
  ("_ -_* _" [51,0,0] 80)
where vp_def:"n -as* n'  n -as→* n'  valid_path as"


lemma intra_path_vp:
  assumes "n -asι* n'" shows "n -as* n'"
proof -
  from n -asι* n' have "n -as→* n'" and "a  set as. intra_kind(kind a)"
    by(simp_all add:intra_path_def)
  from a  set as. intra_kind(kind a) have "valid_path_aux [] as"
    by(rule valid_path_aux_intra_path)
  thus ?thesis using n -as→* n' by(simp add:vp_def valid_path_def)
qed


lemma vp_split_Cons:
  assumes "n -as* n'" and "as  []"
  obtains a' as' where "as = a'#as'" and "n = sourcenode a'"
  and "valid_edge a'" and "targetnode a' -as'* n'"
proof(atomize_elim)
  from n -as* n' as  [] obtain a' as' where "as = a'#as'"
    and "n = sourcenode a'" and "valid_edge a'" and "targetnode a' -as'→* n'"
    by(fastforce elim:path_split_Cons simp:vp_def)
  from n -as* n' have "valid_path as" by(simp add:vp_def)
  from as = a'#as' have "as = [a']@as'" by simp
  with ‹valid_path as have "valid_path ([a']@as')" by simp
  hence "valid_path as'" by(rule valid_path_split)
  with targetnode a' -as'→* n' have "targetnode a' -as'* n'" by(simp add:vp_def)
  with as = a'#as' n = sourcenode a' valid_edge a'
  show "a' as'. as = a'#as'  n = sourcenode a'  valid_edge a'  
                 targetnode a' -as'* n'" by blast
qed

lemma vp_split_snoc:
  assumes "n -as* n'" and "as  []"
  obtains a' as' where "as = as'@[a']" and "n -as'* sourcenode a'"
  and "valid_edge a'" and "n' = targetnode a'"
proof(atomize_elim)
  from n -as* n' as  [] obtain a' as' where "as = as'@[a']"
    and "n -as'→* sourcenode a'" and "valid_edge a'" and "n' = targetnode a'"
    by(clarsimp simp:vp_def)(erule path_split_snoc,auto)
  from n -as* n' as = as'@[a'] have "valid_path (as'@[a'])" by(simp add:vp_def)
  hence "valid_path as'" by(rule valid_path_split)
  with n -as'→* sourcenode a' have "n -as'* sourcenode a'" by(simp add:vp_def)
  with as = as'@[a'] valid_edge a' n' = targetnode a'
  show "as' a'. as = as'@[a']  n -as'* sourcenode a'  valid_edge a'  
                 n' = targetnode a'"
  by blast
qed

lemma vp_split:
  assumes "n -as@a#as'* n'"
  shows "n -as* sourcenode a" and "valid_edge a" and "targetnode a -as'* n'"
proof -
  from n -as@a#as'* n' have "n -as→* sourcenode a" and "valid_edge a" 
    and "targetnode a -as'→* n'"
    by(auto intro:path_split simp:vp_def)
  from n -as@a#as'* n' have "valid_path (as@a#as')" by(simp add:vp_def)
  hence "valid_path as" and "valid_path (a#as')" by(auto intro:valid_path_split)
  from ‹valid_path (a#as') have "valid_path ([a]@as')" by simp
  hence "valid_path as'"  by(rule valid_path_split)
  with n -as→* sourcenode a ‹valid_path as valid_edge a targetnode a -as'→* n'
  show "n -as* sourcenode a" "valid_edge a" "targetnode a -as'* n'"
    by(auto simp:vp_def)
qed

lemma vp_split_second:
  assumes "n -as@a#as'* n'" shows "sourcenode a -a#as'* n'"
proof -
  from n -as@a#as'* n' have "sourcenode a -a#as'→* n'"
    by(fastforce elim:path_split_second simp:vp_def)
  from n -as@a#as'* n' have "valid_path (as@a#as')" by(simp add:vp_def)
  hence "valid_path (a#as')" by(rule valid_path_split)
  with sourcenode a -a#as'→* n' show ?thesis by(simp add:vp_def)
qed




function valid_path_rev_aux :: "'edge list  'edge list  bool"
  where "valid_path_rev_aux cs []  True"
  | "valid_path_rev_aux cs (as@[a])  
       (case (kind a) of Qpf  valid_path_rev_aux (a#cs) as
                       | Q:rpfs  case cs of []  valid_path_rev_aux [] as
                                     | c'#cs'  c'  get_return_edges a 
                                                 valid_path_rev_aux cs' as
                       |    _  valid_path_rev_aux cs as)"
by auto(case_tac b rule:rev_cases,auto)
termination by lexicographic_order



lemma vpra_induct [consumes 1,case_names vpra_empty vpra_intra vpra_Return 
  vpra_CallEmpty vpra_CallCons]:
  assumes major: "valid_path_rev_aux xs ys"
  and rules: "cs. P cs []"
    "cs a as. intra_kind(kind a); valid_path_rev_aux cs as; P cs as 
       P cs (as@[a])"
    "cs a as Q p f. kind a = Qpf; valid_path_rev_aux (a#cs) as; P (a#cs) as 
       P cs (as@[a])"
    "cs a as Q r p fs. kind a = Q:rpfs; cs = []; valid_path_rev_aux [] as; 
         P [] as  P cs (as@[a])"
    "cs a as Q r p fs c' cs'. kind a = Q:rpfs; cs = c'#cs'; 
         valid_path_rev_aux cs' as; c'  get_return_edges a; P cs' as
      P cs (as@[a])"
  shows "P xs ys"
using major
apply(induct ys arbitrary:xs rule:rev_induct)
by(auto intro:rules split:edge_kind.split_asm list.split_asm simp:intra_kind_def)


lemma vpra_callstack_prefix:
  "valid_path_rev_aux (cs@cs') as  valid_path_rev_aux cs as"
proof(induct "cs@cs'" as arbitrary:cs cs' rule:vpra_induct)
  case vpra_empty thus ?case by simp
next
  case (vpra_intra a as)
  hence "valid_path_rev_aux cs as" by simp
  with ‹intra_kind (kind a) show ?case by(fastforce simp:intra_kind_def)
next
  case (vpra_Return a as Q p f)
  note IH = ds ds'. a#cs@cs' = ds@ds'  valid_path_rev_aux ds as
  have "a#cs@cs' = (a#cs)@cs'" by simp
  from IH[OF this] have "valid_path_rev_aux (a#cs) as" .
  with kind a = Qpf show ?case by simp
next
  case (vpra_CallEmpty a as Q r p fs)
  hence "valid_path_rev_aux cs as" by simp
  with kind a = Q:rpfs cs@cs' = [] show ?case by simp
next
  case (vpra_CallCons a as Q r p fs c' csx)
  note IH = cs cs'. csx = cs@cs'  valid_path_rev_aux cs as
  from cs@cs' = c'#csx
  have "(cs = []  cs' = c'#csx)  (zs. cs = c'#zs  zs@cs' = csx)"
    by(simp add:append_eq_Cons_conv)
  thus ?case
  proof
    assume "cs = []  cs' = c'#csx"
    hence "cs = []" and "cs' = c'#csx" by simp_all
    from cs' = c'#csx have "csx = []@tl cs'" by simp
    from IH[OF this] have "valid_path_rev_aux [] as" .
    with cs = [] kind a = Q:rpfs show ?thesis by simp
  next
    assume "zs. cs = c'#zs  zs@cs' = csx"
    then obtain zs where "cs = c'#zs" and "csx = zs@cs'" by auto
    from IH[OF csx = zs@cs'] have "valid_path_rev_aux zs as" .
    with cs = c'#zs kind a = Q:rpfs c'  get_return_edges a show ?thesis by simp
  qed
qed



function upd_rev_cs :: "'edge list  'edge list  'edge list"
  where "upd_rev_cs cs [] = cs"
  | "upd_rev_cs cs (as@[a]) =
       (case (kind a) of Qpf  upd_rev_cs (a#cs) as
                       | Q:rpfs  case cs of []  upd_rev_cs cs as
                                      | c'#cs'  upd_rev_cs cs' as
                       |    _  upd_rev_cs cs as)"
by auto(case_tac b rule:rev_cases,auto)
termination by lexicographic_order


lemma upd_rev_cs_empty [dest]:
  "upd_rev_cs cs [] = []  cs = []"
by(cases cs) auto


lemma valid_path_rev_aux_split:
  assumes "valid_path_rev_aux cs (as@as')"
  shows "valid_path_rev_aux cs as'" and "valid_path_rev_aux (upd_rev_cs cs as') as"
  using ‹valid_path_rev_aux cs (as@as')
proof(induct cs "as@as'" arbitrary:as as' rule:vpra_induct)
  case (vpra_intra cs a as as'')
  note IH1 = xs ys. as = xs@ys  valid_path_rev_aux cs ys
  note IH2 = xs ys. as = xs@ys  valid_path_rev_aux (upd_rev_cs cs ys) xs
  { case 1
    from vpra_intra
    have "as' = []  as@[a] = as''  (xs. as = as''@xs  xs@[a] = as')"
      by(cases as' rule:rev_cases) auto
    thus ?case
    proof
      assume "as' = []  as@[a] = as''"
      thus ?thesis by simp
    next
      assume "xs. as = as''@xs  xs@[a] = as'"
      then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
      from IH1[OF as = as''@xs] have "valid_path_rev_aux cs xs" .
      with xs@[a] = as' ‹intra_kind (kind a)
      show ?thesis by(fastforce simp:intra_kind_def)
    qed
  next
    case 2
    from vpra_intra
    have "as' = []  as@[a] = as''  (xs. as = as''@xs  xs@[a] = as')"
      by(cases as' rule:rev_cases) auto
    thus ?case
    proof
      assume "as' = []  as@[a] = as''"
      hence "as = butlast as''@[]" by(cases as) auto
      from IH2[OF this] have "valid_path_rev_aux (upd_rev_cs cs []) (butlast as'')" .
      with as' = []  as@[a] = as'' ‹intra_kind (kind a)
      show ?thesis by(fastforce simp:intra_kind_def)
    next
      assume "xs. as = as''@xs  xs@[a] = as'"
      then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
      from IH2[OF as = as''@xs] have "valid_path_rev_aux (upd_rev_cs cs xs) as''" .
      from xs@[a] = as' ‹intra_kind (kind a) 
      have "upd_rev_cs cs xs = upd_rev_cs cs as'" by(fastforce simp:intra_kind_def)
      with ‹valid_path_rev_aux (upd_rev_cs cs xs) as''
      show ?thesis by simp
    qed
  }
next
  case (vpra_Return cs a as Q p f as'')
  note IH1 = xs ys. as = xs@ys  valid_path_rev_aux (a#cs) ys
  note IH2 = xs ys. as = xs@ys  valid_path_rev_aux (upd_rev_cs (a#cs) ys) xs
  { case 1
    from vpra_Return
    have "as' = []  as@[a] = as''  (xs. as = as''@xs  xs@[a] = as')"
      by(cases as' rule:rev_cases) auto
    thus ?case
    proof
      assume "as' = []  as@[a] = as''"
      thus ?thesis by simp
    next
      assume "xs. as = as''@xs  xs@[a] = as'"
      then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
      from IH1[OF as = as''@xs] have "valid_path_rev_aux (a#cs) xs" .
      with xs@[a] = as' kind a = Qpf
      show ?thesis by fastforce
    qed
  next
    case 2
    from vpra_Return
    have "as' = []  as@[a] = as''  (xs. as = as''@xs  xs@[a] = as')"
      by(cases as' rule:rev_cases) auto
    thus ?case
    proof
      assume "as' = []  as@[a] = as''"
      hence "as = butlast as''@[]" by(cases as) auto
      from IH2[OF this] 
      have "valid_path_rev_aux (upd_rev_cs (a#cs) []) (butlast as'')" .
      with as' = []  as@[a] = as'' kind a = Qpf
      show ?thesis by fastforce
    next
      assume "xs. as = as''@xs  xs@[a] = as'"
      then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
      from IH2[OF as = as''@xs] 
      have "valid_path_rev_aux (upd_rev_cs (a#cs) xs) as''" .
      from xs@[a] = as' kind a = Qpf
      have "upd_rev_cs (a#cs) xs = upd_rev_cs cs as'" by fastforce
      with ‹valid_path_rev_aux (upd_rev_cs (a#cs) xs) as''
      show ?thesis by simp
    qed
  }
next
  case (vpra_CallEmpty cs a as Q r p fs as'')
  note IH1 = xs ys. as = xs@ys  valid_path_rev_aux [] ys
  note IH2 = xs ys. as = xs@ys  valid_path_rev_aux (upd_rev_cs [] ys) xs
  { case 1
    from vpra_CallEmpty
    have "as' = []  as@[a] = as''  (xs. as = as''@xs  xs@[a] = as')"
      by(cases as' rule:rev_cases) auto
    thus ?case
    proof
      assume "as' = []  as@[a] = as''"
      thus ?thesis by simp
    next
      assume "xs. as = as''@xs  xs@[a] = as'"
      then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
      from IH1[OF as = as''@xs] have "valid_path_rev_aux [] xs" .
      with xs@[a] = as' kind a = Q:rpfs cs = []
      show ?thesis by fastforce
    qed
  next
    case 2
    from vpra_CallEmpty
    have "as' = []  as@[a] = as''  (xs. as = as''@xs  xs@[a] = as')"
      by(cases as' rule:rev_cases) auto
    thus ?case
    proof
      assume "as' = []  as@[a] = as''"
      hence "as = butlast as''@[]" by(cases as) auto
      from IH2[OF this] 
      have "valid_path_rev_aux (upd_rev_cs [] []) (butlast as'')" .
      with as' = []  as@[a] = as'' kind a = Q:rpfs cs = []
      show ?thesis by fastforce
    next
      assume "xs. as = as''@xs  xs@[a] = as'"
      then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
      from IH2[OF as = as''@xs] 
      have "valid_path_rev_aux (upd_rev_cs [] xs) as''" .
      with xs@[a] = as' kind a = Q:rpfs cs = [] 
      show ?thesis by fastforce
    qed
  }
next
  case (vpra_CallCons cs a as Q r p fs c' cs' as'')
  note IH1 = xs ys. as = xs@ys  valid_path_rev_aux cs' ys
  note IH2 = xs ys. as = xs@ys  valid_path_rev_aux (upd_rev_cs cs' ys) xs
  { case 1
    from vpra_CallCons
    have "as' = []  as@[a] = as''  (xs. as = as''@xs  xs@[a] = as')"
      by(cases as' rule:rev_cases) auto
    thus ?case
    proof
      assume "as' = []  as@[a] = as''"
      thus ?thesis by simp
    next
      assume "xs. as = as''@xs  xs@[a] = as'"
      then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
      from IH1[OF as = as''@xs] have "valid_path_rev_aux cs' xs" .
      with xs@[a] = as' kind a = Q:rpfs cs = c' # cs' c'  get_return_edges a
      show ?thesis by fastforce
    qed
  next
    case 2
    from vpra_CallCons
    have "as' = []  as@[a] = as''  (xs. as = as''@xs  xs@[a] = as')"
      by(cases as' rule:rev_cases) auto
    thus ?case
    proof
      assume "as' = []  as@[a] = as''"
      hence "as = butlast as''@[]" by(cases as) auto
      from IH2[OF this] 
      have "valid_path_rev_aux (upd_rev_cs cs' []) (butlast as'')" .
      with as' = []  as@[a] = as'' kind a = Q:rpfs cs = c' # cs'
        c'  get_return_edges a show ?thesis by fastforce
    next
      assume "xs. as = as''@xs  xs@[a] = as'"
      then obtain xs where "as = as''@xs" and "xs@[a] = as'" by auto
      from IH2[OF as = as''@xs] 
      have "valid_path_rev_aux (upd_rev_cs cs' xs) as''" .
      with xs@[a] = as' kind a = Q:rpfs cs = c' # cs'
        c'  get_return_edges a
      show ?thesis by fastforce
    qed
  }
qed simp_all


lemma valid_path_rev_aux_Append:
  "valid_path_rev_aux cs as'; valid_path_rev_aux (upd_rev_cs cs as') as
   valid_path_rev_aux cs (as@as')"
by(induct rule:vpra_induct,
   auto simp:intra_kind_def simp del:append_assoc simp:append_assoc[THEN sym])


lemma vpra_Cons_intra:
  assumes "intra_kind(kind a)"
  shows "valid_path_rev_aux cs as  valid_path_rev_aux cs (a#as)"
proof(induct rule:vpra_induct)
  case (vpra_empty cs)
  have "valid_path_rev_aux cs []" by simp
  with ‹intra_kind(kind a) have "valid_path_rev_aux cs ([]@[a])"
    by(simp only:valid_path_rev_aux.simps intra_kind_def,fastforce)
  thus ?case by simp
qed(simp only:append_Cons[THEN sym] valid_path_rev_aux.simps intra_kind_def,fastforce)+


lemma vpra_Cons_Return:
  assumes "kind a = Qpf"
  shows "valid_path_rev_aux cs as  valid_path_rev_aux cs (a#as)"
proof(induct rule:vpra_induct)
  case (vpra_empty cs)
  from kind a = Qpf have "valid_path_rev_aux cs ([]@[a])"
    by(simp only:valid_path_rev_aux.simps,clarsimp)
  thus ?case by simp
next
  case (vpra_intra cs a' as')
  from ‹valid_path_rev_aux cs (a#as') ‹intra_kind (kind a')
  have "valid_path_rev_aux cs ((a#as')@[a'])"
    by(simp only:valid_path_rev_aux.simps,fastforce simp:intra_kind_def)
  thus ?case by simp
next
  case (vpra_Return cs a' as' Q' p' f')
  from ‹valid_path_rev_aux (a'#cs) (a#as') kind a' = Q'p'f'
  have "valid_path_rev_aux cs ((a#as')@[a'])"
    by(simp only:valid_path_rev_aux.simps,clarsimp)
  thus ?case by simp
next
  case (vpra_CallEmpty cs a' as' Q' r' p' fs')
  from ‹valid_path_rev_aux [] (a#as') kind a' = Q':r'p'fs' cs = []
  have "valid_path_rev_aux cs ((a#as')@[a'])"
    by(simp only:valid_path_rev_aux.simps,clarsimp)
  thus ?case by simp
next
  case (vpra_CallCons cs a' as' Q' r' p' fs' c' cs')
  from ‹valid_path_rev_aux cs' (a#as') kind a' = Q':r'p'fs' cs = c'#cs'
    c'  get_return_edges a'
  have "valid_path_rev_aux cs ((a#as')@[a'])"
    by(simp only:valid_path_rev_aux.simps,clarsimp)
  thus ?case by simp
qed


(*<*)
lemmas append_Cons_rev = append_Cons[THEN sym]
declare append_Cons [simp del] append_Cons_rev [simp]
(*>*)

lemma upd_rev_cs_Cons_intra:
  assumes "intra_kind(kind a)" shows "upd_rev_cs cs (a#as) = upd_rev_cs cs as"
proof(induct as arbitrary:cs rule:rev_induct)
  case Nil
  from ‹intra_kind (kind a)
  have "upd_rev_cs cs ([]@[a]) = upd_rev_cs cs []"
    by(simp only:upd_rev_cs.simps,auto simp:intra_kind_def)
  thus ?case by simp
next
  case (snoc a' as')
  note IH = cs. upd_rev_cs cs (a#as') = upd_rev_cs cs as'
  show ?case
  proof(cases "kind a'" rule:edge_kind_cases)
    case Intra
    from IH have "upd_rev_cs cs (a#as') = upd_rev_cs cs as'" .
    with Intra have "upd_rev_cs cs ((a#as')@[a']) = upd_rev_cs cs (as'@[a'])"
      by(fastforce simp:intra_kind_def)
    thus ?thesis by simp
  next
    case Return
    from IH have "upd_rev_cs (a'#cs) (a#as') = upd_rev_cs (a'#cs) as'" .
    with Return have "upd_rev_cs cs ((a#as')@[a']) = upd_rev_cs cs (as'@[a'])"
      by(auto simp:intra_kind_def)
    thus ?thesis by simp
  next
    case Call
    show ?thesis
    proof(cases cs)
      case Nil
      from IH have "upd_rev_cs [] (a#as') = upd_rev_cs [] as'" .
      with Call Nil have "upd_rev_cs cs ((a#as')@[a']) = upd_rev_cs cs (as'@[a'])"
        by(auto simp:intra_kind_def)
      thus ?thesis by simp
    next
      case (Cons c' cs')
      from IH have "upd_rev_cs cs' (a#as') = upd_rev_cs cs' as'" .
      with Call Cons have "upd_rev_cs cs ((a#as')@[a']) = upd_rev_cs cs (as'@[a'])"
        by(auto simp:intra_kind_def)
      thus ?thesis by simp
    qed
  qed
qed



lemma upd_rev_cs_Cons_Return:
  assumes "kind a = Qpf" shows "upd_rev_cs cs (a#as) = a#(upd_rev_cs cs as)"
proof(induct as arbitrary:cs rule:rev_induct)
  case Nil
  with kind a = Qpf have "upd_rev_cs cs ([]@[a]) = a#(upd_rev_cs cs [])"
    by(simp only:upd_rev_cs.simps) clarsimp
  thus ?case by simp
next
  case (snoc a' as')
  note IH = cs. upd_rev_cs cs (a#as') = a#upd_rev_cs cs as'
  show ?case
  proof(cases "kind a'" rule:edge_kind_cases)
    case Intra
    from IH have "upd_rev_cs cs (a#as') = a#(upd_rev_cs cs as')" .
    with Intra have "upd_rev_cs cs ((a#as')@[a']) = a#(upd_rev_cs cs (as'@[a']))"
      by(fastforce simp:intra_kind_def)
    thus ?thesis by simp
  next
    case Return
    from IH have "upd_rev_cs (a'#cs) (a#as') = a#(upd_rev_cs (a'#cs) as')" .
    with Return have "upd_rev_cs cs ((a#as')@[a']) = a#(upd_rev_cs cs (as'@[a']))"
      by(auto simp:intra_kind_def)
    thus ?thesis by simp
  next
    case Call
    show ?thesis
    proof(cases cs)
      case Nil
      from IH have "upd_rev_cs [] (a#as') = a#(upd_rev_cs [] as')" .
      with Call Nil have "upd_rev_cs cs ((a#as')@[a']) = a#(upd_rev_cs cs (as'@[a']))"
        by(auto simp:intra_kind_def)
      thus ?thesis by simp
    next
      case (Cons c' cs')
      from IH have "upd_rev_cs cs' (a#as') = a#(upd_rev_cs cs' as')" .
      with Call Cons 
      have "upd_rev_cs cs ((a#as')@[a']) = a#(upd_rev_cs cs (as'@[a']))"
        by(auto simp:intra_kind_def)
      thus ?thesis by simp
    qed
  qed
qed


lemma upd_rev_cs_Cons_Call_Cons:
  assumes "kind a = Q:rpfs"
  shows "upd_rev_cs cs as = c'#cs'  upd_rev_cs cs (a#as) = cs'"
proof(induct as arbitrary:cs rule:rev_induct)
  case Nil
  with kind a = Q:rpfs have "upd_rev_cs cs ([]@[a]) = cs'"
    by(simp only:upd_rev_cs.simps) clarsimp
 thus ?case by simp
next
  case (snoc a' as')
  note IH = cs. upd_rev_cs cs as' = c'#cs'  upd_rev_cs cs (a#as') = cs'
  show ?case
  proof(cases "kind a'" rule:edge_kind_cases)
    case Intra
    with ‹upd_rev_cs cs (as'@[a']) = c'#cs'
    have "upd_rev_cs cs as' = c'#cs'" by(fastforce simp:intra_kind_def)
    from IH[OF this] have "upd_rev_cs cs (a#as') = cs'" .
    with Intra show ?thesis by(fastforce simp:intra_kind_def)
  next
    case Return
    with ‹upd_rev_cs cs (as'@[a']) = c'#cs'
    have "upd_rev_cs (a'#cs) as' = c'#cs'" by simp
    from IH[OF this] have "upd_rev_cs (a'#cs) (a#as') = cs'" .
    with Return show ?thesis by simp
  next
    case Call
    show ?thesis
    proof(cases cs)
      case Nil
      with ‹upd_rev_cs cs (as'@[a']) = c'#cs' Call
      have "upd_rev_cs cs as' = c'#cs'" by simp
      from IH[OF this] have "upd_rev_cs cs (a#as') = cs'" .
      with Nil Call show ?thesis by simp
    next
      case (Cons cx csx)
      with ‹upd_rev_cs cs (as'@[a']) = c'#cs' Call
      have "upd_rev_cs csx as' = c'#cs'" by simp
      from IH[OF this] have "upd_rev_cs csx (a#as') = cs'" .
      with Cons Call show ?thesis by simp
    qed
  qed
qed


lemma upd_rev_cs_Cons_Call_Cons_Empty:
  assumes "kind a = Q:rpfs"
  shows "upd_rev_cs cs as = []  upd_rev_cs cs (a#as) = []"
proof(induct as arbitrary:cs rule:rev_induct)
  case Nil
  with kind a = Q:rpfs have "upd_rev_cs cs ([]@[a]) = []"
    by(simp only:upd_rev_cs.simps) clarsimp
 thus ?case by simp
next
  case (snoc a' as')
  note IH = cs. upd_rev_cs cs as' = []  upd_rev_cs cs (a#as') = []
  show ?case
  proof(cases "kind a'" rule:edge_kind_cases)
    case Intra
    with ‹upd_rev_cs cs (as'@[a']) = []
    have "upd_rev_cs cs as' = []" by(fastforce simp:intra_kind_def)
    from IH[OF this] have "upd_rev_cs cs (a#as') = []" .
    with Intra show ?thesis by(fastforce simp:intra_kind_def)
  next
    case Return
    with ‹upd_rev_cs cs (as'@[a']) = []
    have "upd_rev_cs (a'#cs) as' = []" by simp
    from IH[OF this] have "upd_rev_cs (a'#cs) (a#as') = []" .
    with Return show ?thesis by simp
  next
    case Call
    show ?thesis
    proof(cases cs)
      case Nil
      with ‹upd_rev_cs cs (as'@[a']) = [] Call
      have "upd_rev_cs cs as' = []" by simp
      from IH[OF this] have "upd_rev_cs cs (a#as') = []" .
      with Nil Call show ?thesis by simp
    next
      case (Cons cx csx)
      with ‹upd_rev_cs cs (as'@[a']) = [] Call
      have "upd_rev_cs csx as' = []" by simp
      from IH[OF this] have "upd_rev_cs csx (a#as') = []" .
      with Cons Call show ?thesis by simp
    qed
  qed
qed

(*<*)declare append_Cons [simp] append_Cons_rev [simp del](*>*)


definition valid_call_list :: "'edge list  'node  bool"
  where "valid_call_list cs n 
  cs' c cs''. cs = cs'@c#cs''  (valid_edge c  (Q r p fs. (kind c = Q:rpfs)  
                    p = get_proc (case cs' of []  n | _  last (sourcenodes cs'))))"

definition valid_return_list :: "'edge list  'node  bool"
  where "valid_return_list cs n 
  cs' c cs''. cs = cs'@c#cs''  (valid_edge c  (Q p f. (kind c = Qpf)  
                    p = get_proc (case cs' of []  n | _  last (targetnodes cs'))))"


lemma valid_call_list_valid_edges: 
  assumes "valid_call_list cs n" shows "c  set cs. valid_edge c"
proof -
  from ‹valid_call_list cs n 
  have "cs' c cs''. cs = cs'@c#cs''  valid_edge c"
    by(simp add:valid_call_list_def)
  thus ?thesis
  proof(induct cs)
    case Nil thus ?case by simp
  next
    case (Cons cx csx)
    note IH = cs' c cs''. csx = cs'@c#cs''  valid_edge c 
                            aset csx. valid_edge a
    from cs' c cs''. cx#csx = cs'@c#cs''  valid_edge c
    have "valid_edge cx" by blast
    from cs' c cs''. cx#csx = cs'@c#cs''  valid_edge c
    have "cs' c cs''. csx = cs'@c#cs''  valid_edge c"
      by auto(erule_tac x="cx#cs'" in allE,auto)
    from IH[OF this] valid_edge cx show ?case by simp
  qed
qed


lemma valid_return_list_valid_edges: 
  assumes "valid_return_list rs n" shows "r  set rs. valid_edge r"
proof -
  from ‹valid_return_list rs n 
  have "rs' r rs''. rs = rs'@r#rs''  valid_edge r"
    by(simp add:valid_return_list_def)
  thus ?thesis
  proof(induct rs)
    case Nil thus ?case by simp
  next
    case (Cons rx rsx)
    note IH = rs' r rs''. rsx = rs'@r#rs''  valid_edge r 
                            aset rsx. valid_edge a
    from rs' r rs''. rx#rsx = rs'@r#rs''  valid_edge r
    have "valid_edge rx" by blast
    from rs' r rs''. rx#rsx = rs'@r#rs''  valid_edge r
    have "rs' r rs''. rsx = rs'@r#rs''  valid_edge r"
      by auto(erule_tac x="rx#rs'" in allE,auto)
    from IH[OF this] valid_edge rx show ?case by simp
  qed
qed


lemma vpra_empty_valid_call_list_rev:
  "valid_call_list cs n  valid_path_rev_aux [] (rev cs)"
proof(induct cs arbitrary:n)
  case Nil thus ?case by simp
next
  case (Cons c' cs')
  note IH = n. valid_call_list cs' n  valid_path_rev_aux [] (rev cs')
  from ‹valid_call_list (c'#cs') n have "valid_call_list cs' (sourcenode c')"
    apply(clarsimp simp:valid_call_list_def)
    apply hypsubst_thin
    apply(erule_tac x="c'#cs'" in allE)
    apply clarsimp
    by(case_tac cs',auto simp:sourcenodes_def)
  from IH[OF this] have "valid_path_rev_aux [] (rev cs')" .
  moreover
  from ‹valid_call_list (c'#cs') n obtain Q r p fs where "kind c' = Q:rpfs"
    apply(clarsimp simp:valid_call_list_def)
    by(erule_tac x="[]" in allE) fastforce
  ultimately show ?case by simp
qed


lemma vpa_upd_cs_cases:
  "valid_path_aux cs as; valid_call_list cs n; n -as→* n'
   case (upd_cs cs as) of []  (c  set cs. a  set as. a  get_return_edges c)
                      | cx#csx  valid_call_list (cx#csx) n'"
proof(induct arbitrary:n rule:vpa_induct)
  case (vpa_empty cs)
  from n -[]→* n' have "n = n'" by fastforce
  with ‹valid_call_list cs n show ?case by(cases cs) auto
next
  case (vpa_intra cs a' as')
  note IH = n. valid_call_list cs n; n -as'→* n'
     case (upd_cs cs as') of []  cset cs. aset as'. a  get_return_edges c
                         | cx#csx  valid_call_list (cx # csx) n'
  from ‹intra_kind (kind a') have "upd_cs cs (a'#as') = upd_cs cs as'"
    by(fastforce simp:intra_kind_def)
  from n -a'#as'→* n' have [simp]:"n = sourcenode a'" and "valid_edge a'"
    and "targetnode a' -as'→* n'" by(auto elim:path_split_Cons)
  from valid_edge a' ‹intra_kind (kind a')
  have "get_proc (sourcenode a') = get_proc (targetnode a')" by(rule get_proc_intra)
  with ‹valid_call_list cs n have "valid_call_list cs (targetnode a')"
    apply(clarsimp simp:valid_call_list_def)
    apply(erule_tac x="cs'" in allE) apply clarsimp
    by(case_tac cs') auto
  from IH[OF this targetnode a' -as'→* n'] ‹upd_cs cs (a'#as') = upd_cs cs as'
  show ?case by(cases "upd_cs cs as'") auto
next
  case (vpa_Call cs a' as' Q r p fs)
  note IH = n. valid_call_list (a'#cs) n; n -as'→* n'
     case (upd_cs (a'#cs) as') 
             of []  cset (a'#cs). aset as'. a  get_return_edges c
          | cx#csx  valid_call_list (cx # csx) n'
  from kind a' = Q:rpfs have "upd_cs (a'#cs) as' = upd_cs cs (a'#as')"
    by simp
  from n -a'#as'→* n' have [simp]:"n = sourcenode a'" and "valid_edge a'"
    and "targetnode a' -as'→* n'" by(auto elim:path_split_Cons)
  from valid_edge a' kind a' = Q:rpfs
  have "get_proc (targetnode a') = p" by(rule get_proc_call)
  with valid_edge a' kind a' = Q:rpfs ‹valid_call_list cs n
  have "valid_call_list (a'#cs) (targetnode a')"
    apply(clarsimp simp:valid_call_list_def)
    apply(case_tac cs') apply auto
    apply(erule_tac x="list" in allE) apply clarsimp
    by(case_tac list,auto simp:sourcenodes_def)
  from IH[OF this targetnode a' -as'→* n'] 
    ‹upd_cs (a'#cs) as' = upd_cs cs (a'#as')
  have "case upd_cs cs (a'#as') 
         of []  cset (a' # cs). aset as'. a  get_return_edges c
    | cx # csx  valid_call_list (cx # csx) n'" by simp
  thus ?case by(cases "upd_cs cs (a'#as')") simp+
next
  case (vpa_ReturnEmpty cs a' as' Q p f)
  note IH = n. valid_call_list [] n; n -as'→* n'
     case (upd_cs [] as') 
             of []  cset []. aset as'. a  get_return_edges c
          | cx#csx  valid_call_list (cx # csx) n'
  from kind a' = Qpf cs = [] have "upd_cs [] as' = upd_cs cs (a'#as')"
    by simp
  from n -a'#as'→* n' have [simp]:"n = sourcenode a'" and "valid_edge a'"
    and "targetnode a' -as'→* n'" by(auto elim:path_split_Cons)
  have "valid_call_list [] (targetnode a')" by(simp add:valid_call_list_def)
  from IH[OF this targetnode a' -as'→* n']
    ‹upd_cs [] as' = upd_cs cs (a'#as')
  have "case (upd_cs cs (a'#as')) 
         of []  cset []. aset as'. a  get_return_edges c
    | cx#csx  valid_call_list (cx#csx) n'" by simp
  with cs = [] show ?case by(cases "upd_cs cs (a'#as')") simp+
next
  case (vpa_ReturnCons cs a' as' Q p f c' cs')
  note IH = n. valid_call_list cs' n; n -as'→* n'
     case (upd_cs cs' as') 
             of []  cset cs'. aset as'. a  get_return_edges c
          | cx#csx  valid_call_list (cx # csx) n'
  from kind a' = Qpf cs = c'#cs' a'  get_return_edges c' 
  have "upd_cs cs' as' = upd_cs cs (a'#as')" by simp
  from n -a'#as'→* n' have [simp]:"n = sourcenode a'" and "valid_edge a'"
    and "targetnode a' -as'→* n'" by(auto elim:path_split_Cons)
  from ‹valid_call_list cs n cs = c'#cs' have "valid_edge c'"
    apply(clarsimp simp:valid_call_list_def)
    by(erule_tac x="[]" in allE,auto)
  with a'  get_return_edges c' obtain ax where "valid_edge ax"
    and sources:"sourcenode ax = sourcenode c'" 
    and targets:"targetnode ax = targetnode a'" and "kind ax = (λcf. False)"
    by(fastforce dest:call_return_node_edge)
  from valid_edge ax sources[THEN sym] targets[THEN sym] kind ax = (λcf. False)
  have "get_proc (sourcenode c') = get_proc (targetnode a')"
    by(fastforce intro:get_proc_intra simp:intra_kind_def)
  with ‹valid_call_list cs n cs = c'#cs'
  have "valid_call_list cs' (targetnode a')"
    apply(clarsimp simp:valid_call_list_def)
    apply(hypsubst_thin)
    apply(erule_tac x="c'#cs'" in allE)
    by(case_tac cs',auto simp:sourcenodes_def)
  from IH[OF this targetnode a' -as'→* n'] 
    ‹upd_cs cs' as' = upd_cs cs (a'#as')
  have "case (upd_cs cs (a'#as')) 
         of []  cset cs'. aset as'. a  get_return_edges c
    | cx#csx  valid_call_list (cx#csx) n'" by simp
  with cs = c' # cs' a'  get_return_edges c' show ?case
    by(cases "upd_cs cs (a'#as')") simp+
qed


lemma vpa_valid_call_list_valid_return_list_vpra:
  "valid_path_aux cs cs'; valid_call_list cs n; valid_return_list cs' n'
   valid_path_rev_aux cs' (rev cs)"
proof(induct arbitrary:n n' rule:vpa_induct)
  case (vpa_empty cs)
  from ‹valid_call_list cs n show ?case by(rule vpra_empty_valid_call_list_rev)
next
  case (vpa_intra cs a as)
  from ‹intra_kind (kind a) ‹valid_return_list (a#as) n'
  have False apply(clarsimp simp:valid_return_list_def)
    by(erule_tac x="[]" in allE,clarsimp simp:intra_kind_def)
  thus ?case by simp
next
  case (vpa_Call cs a as Q r p fs)
  from kind a = Q:rpfs ‹valid_return_list (a#as) n'
  have False apply(clarsimp simp:valid_return_list_def)
    by(erule_tac x="[]" in allE,clarsimp)
  thus ?case by simp
next
  case (vpa_ReturnEmpty cs a as Q p f)
  from cs = [] show ?case by simp
next
  case (vpa_ReturnCons cs a as Q p f c' cs')
  note IH = n n'. valid_call_list cs' n; valid_return_list as n'
     valid_path_rev_aux as (rev cs')
  from ‹valid_return_list (a#as) n' have "valid_return_list as (targetnode a)"
    apply(clarsimp simp:valid_return_list_def)
    apply(erule_tac x="a#cs'" in allE)
    by(case_tac cs',auto simp:targetnodes_def)
  from ‹valid_call_list cs n cs = c'#cs'
  have "valid_call_list cs' (sourcenode c')"
    apply(clarsimp simp:valid_call_list_def)
    apply(erule_tac x="c'#cs'" in allE)
    by(case_tac cs',auto simp:sourcenodes_def)
  from ‹valid_call_list cs n cs = c'#cs' have "valid_edge c'"
    apply(clarsimp simp:valid_call_list_def)
    by(erule_tac x="[]" in allE,auto)
  with a  get_return_edges c' obtain Q' r' p' f' where "kind c' = Q':r'p'f'"
    apply(cases "kind c'" rule:edge_kind_cases)
    by(auto dest:only_call_get_return_edges simp:intra_kind_def)
  from IH[OF ‹valid_call_list cs' (sourcenode c')
    ‹valid_return_list as (targetnode a)]
  have "valid_path_rev_aux as (rev cs')" .
  with kind a = Qpf cs = c'#cs' a  get_return_edges c' kind c' = Q':r'p'f'
  show ?case by simp
qed
 


lemma vpa_to_vpra:
  "valid_path_aux cs as; valid_path_aux (upd_cs cs as) cs'; 
    n -as→* n'; valid_call_list cs n; valid_return_list cs' n'' 
   valid_path_rev_aux cs' as  valid_path_rev_aux (upd_rev_cs cs' as) (rev cs)"
proof(induct arbitrary:n rule:vpa_induct)
  case vpa_empty thus ?case
    by(fastforce intro:vpa_valid_call_list_valid_return_list_vpra)
next
  case (vpa_intra cs a as)
  note IH = n. valid_path_aux (upd_cs cs as) cs'; n -as→* n';
    valid_call_list cs n; valid_return_list cs' n''
     valid_path_rev_aux cs' as 
       valid_path_rev_aux (upd_rev_cs cs' as) (rev cs)
  from n -a#as→* n' have "n = sourcenode a" and "valid_edge a"
    and "targetnode a -as→* n'" by(auto intro:path_split_Cons)
  from valid_edge a ‹intra_kind (kind a)
  have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
  with ‹valid_call_list cs n n = sourcenode a
  have "valid_call_list cs (targetnode a)"
    apply(clarsimp simp:valid_call_list_def)
    apply(erule_tac x="cs'" in allE) apply clarsimp
    by(case_tac cs') auto
  from ‹valid_path_aux (upd_cs cs (a#as)) cs' ‹intra_kind (kind a)
  have "valid_path_aux (upd_cs cs as) cs'"
    by(fastforce simp:intra_kind_def)
  from IH[OF this targetnode a -as→* n' ‹valid_call_list cs (targetnode a)
    ‹valid_return_list cs' n'']
  have "valid_path_rev_aux cs' as" 
    and "valid_path_rev_aux (upd_rev_cs cs' as) (rev cs)" by simp_all
  from  ‹intra_kind (kind a) ‹valid_path_rev_aux cs' as
  have "valid_path_rev_aux cs' (a#as)" by(rule vpra_Cons_intra)
  from ‹intra_kind (kind a) have "upd_rev_cs cs' (a#as) = upd_rev_cs cs' as"
    by(simp add:upd_rev_cs_Cons_intra)
  with ‹valid_path_rev_aux (upd_rev_cs cs' as) (rev cs)
  have "valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)" by simp
  with ‹valid_path_rev_aux cs' (a#as) show ?case by simp
next
  case (vpa_Call cs a as Q r p fs)
  note IH = n. valid_path_aux (upd_cs (a#cs) as) cs'; n -as→* n';
    valid_call_list (a#cs) n; valid_return_list cs' n''
     valid_path_rev_aux cs' as 
       valid_path_rev_aux (upd_rev_cs cs' as) (rev (a#cs))
  from n -a#as→* n' have "n = sourcenode a" and "valid_edge a"
    and "targetnode a -as→* n'" by(auto intro:path_split_Cons)
  from valid_edge a kind a = Q:rpfs have "p = get_proc (targetnode a)"
    by(rule get_proc_call[THEN sym])
  from ‹valid_call_list cs n n = sourcenode a
  have "valid_call_list cs (sourcenode a)" by simp
  with kind a = Q:rpfs valid_edge a p = get_proc (targetnode a)
  have "valid_call_list (a#cs) (targetnode a)"
    apply(clarsimp simp:valid_call_list_def)
    apply(case_tac cs') apply auto
    apply(erule_tac x="list" in allE) apply clarsimp
    by(case_tac list,auto simp:sourcenodes_def)
  from kind a = Q:rpfs have "upd_cs cs (a#as) = upd_cs (a#cs) as"
    by simp
  with ‹valid_path_aux (upd_cs cs (a#as)) cs'
  have "valid_path_aux (upd_cs (a#cs) as) cs'" by simp
  from IH[OF this targetnode a -as→* n' ‹valid_call_list (a#cs) (targetnode a)
    ‹valid_return_list cs' n'']
  have "valid_path_rev_aux cs' as"
    and "valid_path_rev_aux (upd_rev_cs cs' as) (rev (a#cs))" by simp_all
  show ?case
  proof(cases "upd_rev_cs cs' as")
    case Nil
    with kind a = Q:rpfs
    have "upd_rev_cs cs' (a#as) = []" by(rule upd_rev_cs_Cons_Call_Cons_Empty)
    with ‹valid_path_rev_aux (upd_rev_cs cs' as) (rev (a#cs)) kind a = Q:rpfs Nil
    have "valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)" by simp
    from Nil kind a = Q:rpfs have "valid_path_rev_aux (upd_rev_cs cs' as) ([]@[a])"
      by(simp only:valid_path_rev_aux.simps) clarsimp
    with ‹valid_path_rev_aux cs' as have "valid_path_rev_aux cs' ([a]@as)"
      by(fastforce intro:valid_path_rev_aux_Append)
    with ‹valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)
    show ?thesis by simp
  next
    case (Cons cx csx)
    with ‹valid_path_rev_aux (upd_rev_cs cs' as) (rev (a#cs)) kind a = Q:rpfs
    have match:"cx  get_return_edges a" "valid_path_rev_aux csx (rev cs)" by auto
    from kind a = Q:rpfs Cons have "upd_rev_cs cs' (a#as) = csx"
      by(rule upd_rev_cs_Cons_Call_Cons)
    with ‹valid_path_rev_aux (upd_rev_cs cs' as) (rev(a#cs)) kind a = Q:rpfs match
    have "valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)" by simp
    from Cons kind a = Q:rpfs match
    have "valid_path_rev_aux (upd_rev_cs cs' as) ([]@[a])"
      by(simp only:valid_path_rev_aux.simps) clarsimp
    with ‹valid_path_rev_aux cs' as have "valid_path_rev_aux cs' ([a]@as)"
      by(fastforce intro:valid_path_rev_aux_Append)
    with ‹valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)
    show ?thesis by simp
  qed
next
  case (vpa_ReturnEmpty cs a as Q p f)
  note IH = n. valid_path_aux (upd_cs [] as) cs'; n -as→* n';
    valid_call_list [] n; valid_return_list cs' n''
     valid_path_rev_aux cs' as 
       valid_path_rev_aux (upd_rev_cs cs' as) (rev [])
  from n -a#as→* n' have "n = sourcenode a" and "valid_edge a"
    and "targetnode a -as→* n'" by(auto intro:path_split_Cons)
  from cs = [] kind a = Qpf have "upd_cs cs (a#as) = upd_cs [] as"
    by simp
  with ‹valid_path_aux (upd_cs cs (a#as)) cs'
  have "valid_path_aux (upd_cs [] as) cs'" by simp
  from IH[OF this targetnode a -as→* n' _ ‹valid_return_list cs' n'']
  have "valid_path_rev_aux cs' as" 
    and "valid_path_rev_aux (upd_rev_cs cs' as) (rev [])" 
    by(auto simp:valid_call_list_def)
  from kind a = Qpf ‹valid_path_rev_aux cs' as
  have "valid_path_rev_aux cs' (a#as)" by(rule vpra_Cons_Return)
  moreover
  from cs = [] have "valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)"
    by simp
  ultimately show ?case by simp
next
  case (vpa_ReturnCons cs a as Q p f cx csx)
  note IH = n. valid_path_aux (upd_cs csx as) cs'; n -as→* n';
    valid_call_list csx n; valid_return_list cs' n''
     valid_path_rev_aux cs' as 
       valid_path_rev_aux (upd_rev_cs cs' as) (rev csx)
  note match = cs = cx#csx a  get_return_edges cx
  from n -a#as→* n' have "n = sourcenode a" and "valid_edge a"
    and "targetnode a -as→* n'" by(auto intro:path_split_Cons)
  from cs = cx#csx ‹valid_call_list cs n have "valid_edge cx"
    apply(clarsimp simp:valid_call_list_def)
    by(erule_tac x="[]" in allE) clarsimp
  with match have "get_proc (sourcenode cx) = get_proc (targetnode a)"
    by(fastforce intro:get_proc_get_return_edge)
  with ‹valid_call_list cs n cs = cx#csx
  have "valid_call_list csx (targetnode a)"
    apply(clarsimp simp:valid_call_list_def)
    apply(erule_tac x="cx#cs'" in allE) apply clarsimp
    by(case_tac cs',auto simp:sourcenodes_def)
  from kind a = Qpf match have "upd_cs cs (a#as) = upd_cs csx as" by simp
  with ‹valid_path_aux (upd_cs cs (a#as)) cs'
  have "valid_path_aux (upd_cs csx as) cs'" by simp
  from IH[OF this targetnode a -as→* n' ‹valid_call_list csx (targetnode a)
    ‹valid_return_list cs' n'']
  have "valid_path_rev_aux cs' as" 
    and "valid_path_rev_aux (upd_rev_cs cs' as) (rev csx)" by simp_all
  from kind a = Qpf ‹valid_path_rev_aux cs' as
  have "valid_path_rev_aux cs' (a#as)" by(rule vpra_Cons_Return)
  from match valid_edge cx obtain Q' r' p' f' where "kind cx = Q':r'p'f'"
    by(fastforce dest!:only_call_get_return_edges)
  from kind a = Qpf have "upd_rev_cs cs' (a#as) = a#(upd_rev_cs cs' as)"
    by(rule upd_rev_cs_Cons_Return)
  with ‹valid_path_rev_aux (upd_rev_cs cs' as) (rev csx) kind a = Qpf 
    kind cx = Q':r'p'f' match
  have "valid_path_rev_aux (upd_rev_cs cs' (a#as)) (rev cs)"
    by simp
  with ‹valid_path_rev_aux cs' (a#as) show ?case by simp
qed


lemma vp_to_vpra:
  "n -as* n'  valid_path_rev_aux [] as"
by(fastforce elim:vpa_to_vpra[THEN conjunct1] 
            simp:vp_def valid_path_def valid_call_list_def valid_return_list_def)




subsubsection ‹Same level paths›


fun same_level_path_aux :: "'edge list  'edge list  bool"
  where "same_level_path_aux cs []  True"
  | "same_level_path_aux cs (a#as)  
       (case (kind a) of Q:rpfs  same_level_path_aux (a#cs) as
                       | Qpf  case cs of []  False
                                     | c'#cs'  a  get_return_edges c' 
                                             same_level_path_aux cs' as
                       |    _  same_level_path_aux cs as)"


lemma slpa_induct [consumes 1,case_names slpa_empty slpa_intra slpa_Call 
  slpa_Return]:
  assumes major: "same_level_path_aux xs ys"
  and rules: "cs. P cs []"
    "cs a as. intra_kind(kind a); same_level_path_aux cs as; P cs as 
       P cs (a#as)"
    "cs a as Q r p fs. kind a = Q:rpfs; same_level_path_aux (a#cs) as; P (a#cs) as 
       P cs (a#as)"
    "cs a as Q p f c' cs'. kind a = Qpf; cs = c'#cs'; same_level_path_aux cs' as;
                             a  get_return_edges c'; P cs' as
      P cs (a#as)"
  shows "P xs ys"
using major
apply(induct ys arbitrary: xs)
by(auto intro:rules split:edge_kind.split_asm list.split_asm simp:intra_kind_def)


lemma slpa_cases [consumes 4,case_names intra_path return_intra_path]:
  assumes "same_level_path_aux cs as" and "upd_cs cs as = []"
  and "c  set cs. valid_edge c" and "a  set as. valid_edge a"
  obtains "a  set as. intra_kind(kind a)"
  | asx a asx' Q p f c' cs' where "as = asx@a#asx'" and "same_level_path_aux cs asx"
    and "kind a = Qpf" and "upd_cs cs asx = c'#cs'" and "upd_cs cs (asx@[a]) = []" 
    and "a  get_return_edges c'" and "valid_edge c'"
    and "a  set asx'. intra_kind(kind a)"
proof(atomize_elim)
  from assms
  show "(aset as. intra_kind (kind a)) 
    (asx a asx' Q p f c' cs'. as = asx@a#asx'  same_level_path_aux cs asx 
       kind a = Qpf  upd_cs cs asx = c'#cs'  upd_cs cs (asx@[a]) = []  
       a  get_return_edges c'  valid_edge c'  (aset asx'. intra_kind (kind a)))"
  proof(induct rule:slpa_induct)
    case (slpa_empty cs)
    have "aset []. intra_kind (kind a)" by simp
    thus ?case by simp
  next
    case (slpa_intra cs a as)
    note IH = upd_cs cs as = []; cset cs. valid_edge c; a'set as. valid_edge a' 
       (aset as. intra_kind (kind a)) 
      (asx a asx' Q p f c' cs'. as = asx@a#asx'  same_level_path_aux cs asx 
        kind a = Qpf   upd_cs cs asx = c' # cs'  upd_cs cs (asx@[a]) = []  
        a  get_return_edges c'  valid_edge c'  (aset asx'. intra_kind (kind a)))
    from a'set (a#as). valid_edge a' have "a'set as. valid_edge a'" by simp
    from ‹intra_kind (kind a) ‹upd_cs cs (a#as) = []
    have "upd_cs cs as = []" by(fastforce simp:intra_kind_def)
    from IH[OF this cset cs. valid_edge c a'set as. valid_edge a'] show ?case
    proof
      assume "aset as. intra_kind (kind a)"
      with ‹intra_kind (kind a) have "a'set (a#as). intra_kind (kind a')"
        by simp
      thus ?case by simp
    next
      assume "asx a asx' Q p f c' cs'. as = asx@a#asx'  same_level_path_aux cs asx 
                kind a = Qpf  upd_cs cs asx = c'#cs'  upd_cs cs (asx@[a]) = []  
                a  get_return_edges c'  valid_edge c'  
                (aset asx'. intra_kind (kind a))"
      then obtain asx a' Q p f asx' c' cs' where "as = asx@a'#asx'" 
        and "same_level_path_aux cs asx" and "upd_cs cs (asx@[a']) = []"
        and "upd_cs cs asx = c'#cs'" and assms:"a'  get_return_edges c'"
        "kind a' = Qpf" "valid_edge c'" "aset asx'. intra_kind (kind a)"
        by blast
      from as = asx@a'#asx' have "a#as = (a#asx)@a'#asx'" by simp
      moreover
      from ‹intra_kind (kind a) ‹same_level_path_aux cs asx
      have "same_level_path_aux cs (a#asx)" by(fastforce simp:intra_kind_def)
      moreover
      from ‹upd_cs cs asx = c'#cs' ‹intra_kind (kind a)
      have "upd_cs cs (a#asx) = c'#cs'" by(fastforce simp:intra_kind_def)
      moreover
      from ‹upd_cs cs (asx@[a']) = [] ‹intra_kind (kind a)
      have "upd_cs cs ((a#asx)@[a']) = []" by(fastforce simp:intra_kind_def)
      ultimately show ?case using assms by blast
    qed
  next
    case (slpa_Call cs a as Q r p fs)
    note IH = upd_cs (a#cs) as = []; cset (a#cs). valid_edge c;
      a'set as. valid_edge a'  
      (a'set as. intra_kind (kind a')) 
      (asx a' asx' Q' p' f' c' cs'. as = asx@a'#asx'  
        same_level_path_aux (a#cs) asx  kind a' = Q'p'f'  
        upd_cs (a#cs) asx = c'#cs'  upd_cs (a#cs) (asx@[a']) = []  
        a'  get_return_edges c'  valid_edge c'  
        (a'set asx'. intra_kind (kind a')))
    from a'set (a#as). valid_edge a' have "valid_edge a" 
      and "a'set as. valid_edge a'" by simp_all
    from cset cs. valid_edge c valid_edge a have "cset (a#cs). valid_edge c"
      by simp
    from ‹upd_cs cs (a#as) = [] kind a = Q:rpfs
    have "upd_cs (a#cs) as = []" by simp
    from IH[OF this cset (a#cs). valid_edge c a'set as. valid_edge a']
    show ?case
    proof
      assume "a'set as. intra_kind (kind a')"
      with kind a = Q:rpfs have "upd_cs cs (a#as) = a#cs"
        by(fastforce intro:upd_cs_intra_path)
      with ‹upd_cs cs (a#as) = [] have False by simp
      thus ?case by simp
    next
      assume "asx a' asx' Q p f c' cs'. as = asx@a'#asx'  
                same_level_path_aux (a#cs) asx  kind a' = Qpf  
                upd_cs (a#cs) asx = c'#cs'  upd_cs (a#cs) (asx@[a']) = []  
                a'  get_return_edges c'  valid_edge c'  
                (aset asx'. intra_kind (kind a))"
      then obtain asx a' Q' p' f' asx' c' cs' where "as = asx@a'#asx'" 
        and "same_level_path_aux (a#cs) asx" and "upd_cs (a#cs) (asx@[a']) = []"
        and "upd_cs (a#cs) asx = c'#cs'" and assms:"a'  get_return_edges c'"
        "kind a' = Q'p'f'" "valid_edge c'" "aset asx'. intra_kind (kind a)"
        by blast
      from as = asx@a'#asx' have "a#as = (a#asx)@a'#asx'" by simp
      moreover
      from kind a = Q:rpfs ‹same_level_path_aux (a#cs) asx
      have "same_level_path_aux cs (a#asx)" by simp
      moreover
      from kind a = Q:rpfs ‹upd_cs (a#cs) asx = c'#cs'
      have "upd_cs cs (a#asx) = c'#cs'" by simp
      moreover
      from kind a = Q:rpfs ‹upd_cs (a#cs) (asx@[a']) = []
      have "upd_cs cs ((a#asx)@[a']) = []" by simp
      ultimately show ?case using assms by blast
    qed
  next
    case (slpa_Return cs a as Q p f c' cs')
    note IH = upd_cs cs' as = []; cset cs'. valid_edge c; 
      a'set as. valid_edge a'  
      (a'set as. intra_kind (kind a')) 
      (asx a' asx' Q' p' f' c'' cs''. as = asx@a'#asx'  
        same_level_path_aux cs' asx  kind a' = Q'p'f'  upd_cs cs' asx = c''#cs'' 
        upd_cs cs' (asx@[a']) = []  a'  get_return_edges c''  valid_edge c''  
        (a'set asx'. intra_kind (kind a')))
    from a'set (a#as). valid_edge a' have "valid_edge a" 
      and "a'set as. valid_edge a'" by simp_all
    from cset cs. valid_edge c cs = c' # cs'
    have "valid_edge c'" and "cset cs'. valid_edge c" by simp_all
    from ‹upd_cs cs (a#as) = [] kind a = Qpf cs = c'#cs' 
      a  get_return_edges c' have "upd_cs cs' as = []" by simp
    from IH[OF this cset cs'. valid_edge c a'set as. valid_edge a'] show ?case
    proof
      assume "a'set as. intra_kind (kind a')"
      hence "upd_cs cs' as = cs'" by(rule upd_cs_intra_path)
      with ‹upd_cs cs' as = [] have "cs' = []" by simp
      with cs = c'#cs' a  get_return_edges c' kind a = Qpf
      have "upd_cs cs [a] = []" by simp
      moreover
      from cs = c'#cs' have "upd_cs cs []  []" by simp
      moreover
      have "same_level_path_aux cs []" by simp
      ultimately show ?case 
        using kind a = Qpf a'set as. intra_kind (kind a') cs = c'#cs'
          a  get_return_edges c' valid_edge c'
        by fastforce
    next
      assume "asx a' asx' Q' p' f' c'' cs''. as = asx@a'#asx' 
        same_level_path_aux cs' asx  kind a' = Q'p'f'  upd_cs cs' asx = c''#cs'' 
        upd_cs cs' (asx@[a']) = []  a'  get_return_edges c''  valid_edge c'' 
        (a'set asx'. intra_kind (kind a'))"
      then obtain asx a' asx' Q' p' f' c'' cs'' where "as = asx@a'#asx'"
        and "same_level_path_aux cs' asx" and "upd_cs cs' asx = c''#cs''" 
        and "upd_cs cs' (asx@[a']) = []" and assms:"a'  get_return_edges c''" 
        "kind a' = Q'p'f'" "valid_edge c''" "a'set asx'. intra_kind (kind a')"
        by blast
      from as = asx@a'#asx' have "a#as = (a#asx)@a'#asx'" by simp
      moreover
      from ‹same_level_path_aux cs' asx cs = c'#cs' a  get_return_edges c'
        kind a = Qpf
      have "same_level_path_aux cs (a#asx)" by simp
      moreover
      from ‹upd_cs cs' asx = c''#cs'' kind a = Qpf cs = c'#cs'
      have "upd_cs cs (a#asx) = c''#cs''" by simp
      moreover
      from ‹upd_cs cs' (asx@[a']) = [] cs = c'#cs' a  get_return_edges c'
        kind a = Qpf
      have "upd_cs cs ((a#asx)@[a']) = []" by simp
      ultimately show ?case using assms by blast
    qed
  qed
qed


lemma same_level_path_aux_valid_path_aux: 
  "same_level_path_aux cs as  valid_path_aux cs as"
by(induct rule:slpa_induct,auto split:edge_kind.split simp:intra_kind_def)


lemma same_level_path_aux_Append:
  "same_level_path_aux cs as; same_level_path_aux (upd_cs cs as) as'
   same_level_path_aux cs (as@as')"
by(induct rule:slpa_induct,auto simp:intra_kind_def)


lemma same_level_path_aux_callstack_Append:
  "same_level_path_aux cs as  same_level_path_aux (cs@cs') as"
by(induct rule:slpa_induct,auto simp:intra_kind_def)


lemma same_level_path_upd_cs_callstack_Append:
  "same_level_path_aux cs as; upd_cs cs as = cs' 
   upd_cs (cs@cs'') as = (cs'@cs'')"
by(induct rule:slpa_induct,auto split:edge_kind.split simp:intra_kind_def)


lemma slpa_split:
  assumes "same_level_path_aux cs as" and "as = xs@ys" and "upd_cs cs xs = []"
  shows "same_level_path_aux cs xs" and "same_level_path_aux [] ys"
using assms
proof(induct arbitrary:xs ys rule:slpa_induct)
  case (slpa_empty cs) case 1
  from [] = xs@ys show ?case by simp
next
  case (slpa_empty cs) case 2
  from [] = xs@ys show ?case by simp
next
  case (slpa_intra cs a as)
  note IH1 = xs ys. as = xs@ys; upd_cs cs xs = []  same_level_path_aux cs xs
  note IH2 = xs ys. as = xs@ys; upd_cs cs xs = []  same_level_path_aux [] ys
  { case 1
    show ?case
    proof(cases xs)
      case Nil thus ?thesis by simp
    next
      case (Cons x' xs')
      with a#as = xs@ys have "a = x'" and "as = xs'@ys" by simp_all
      with ‹upd_cs cs xs = [] Cons ‹intra_kind (kind a)
      have "upd_cs cs xs' = []" by(fastforce simp:intra_kind_def)
      from IH1[OF as = xs'@ys this] have "same_level_path_aux cs xs'" .
      with a = x' ‹intra_kind (kind a) Cons
      show ?thesis by(fastforce simp:intra_kind_def)
    qed
  next
    case 2
    show ?case
    proof(cases xs)
      case Nil
      with ‹upd_cs cs xs = [] have "cs = []" by fastforce
      with Nil a#as = xs@ys ‹same_level_path_aux cs as ‹intra_kind (kind a)
      show ?thesis by(cases ys,auto simp:intra_kind_def)
    next
      case (Cons x' xs')
      with a#as = xs@ys have "a = x'" and "as = xs'@ys" by simp_all
      with ‹upd_cs cs xs = [] Cons ‹intra_kind (kind a)
      have "upd_cs cs xs' = []" by(fastforce simp:intra_kind_def)
      from IH2[OF as = xs'@ys this] show ?thesis .
    qed
  }
next
  case (slpa_Call cs a as Q r p fs)
  note IH1 = xs ys. as = xs@ys; upd_cs (a#cs) xs = [] 
     same_level_path_aux (a#cs) xs
  note IH2 = xs ys. as = xs@ys; upd_cs (a#cs) xs = [] 
     same_level_path_aux [] ys
  { case 1
    show ?case
    proof(cases xs)
      case Nil thus ?thesis by simp
    next
      case (Cons x' xs')
      with a#as = xs@ys have "a = x'" and "as = xs'@ys" by simp_all
      with ‹upd_cs cs xs = [] Cons kind a = Q:rpfs
      have "upd_cs (a#cs) xs' = []" by simp
      from IH1[OF as = xs'@ys this] have "same_level_path_aux (a#cs) xs'" .
      with a = x' kind a = Q:rpfs Cons show ?thesis by simp
    qed
  next
    case 2
    show ?case
    proof(cases xs)
      case Nil
      with ‹upd_cs cs xs = [] have "cs = []" by fastforce
      with Nil a#as = xs@ys ‹same_level_path_aux (a#cs) as kind a = Q:rpfs
      show ?thesis by(cases ys) auto
    next
      case (Cons x' xs')
      with a#as = xs@ys have "a = x'" and "as = xs'@ys" by simp_all
      with ‹upd_cs cs xs = [] Cons kind a = Q:rpfs
      have "upd_cs (a#cs) xs' = []" by simp
      from IH2[OF as = xs'@ys this] show ?thesis .
    qed
  }
next
  case (slpa_Return cs a as Q p f c' cs')
  note IH1 = xs ys. as = xs@ys; upd_cs cs' xs = []  same_level_path_aux cs' xs
  note IH2 = xs ys. as = xs@ys; upd_cs cs' xs = []  same_level_path_aux [] ys
  { case 1
    show ?case
    proof(cases xs)
      case Nil thus ?thesis by simp
    next
      case (Cons x' xs')
      with a#as = xs@ys have "a = x'" and "as = xs'@ys" by simp_all
      with ‹upd_cs cs xs = [] Cons kind a = Qpf cs = c'#cs'
      have "upd_cs cs' xs' = []" by simp
      from IH1[OF as = xs'@ys this] have "same_level_path_aux cs' xs'" .
      with a = x' kind a = Qpf cs = c'#cs' a  get_return_edges c' Cons 
      show ?thesis by simp
    qed
  next
    case 2
    show ?case
    proof(cases xs)
      case Nil
      with ‹upd_cs cs xs = [] have "cs = []" by fastforce 
      with cs = c'#cs' have False by simp
      thus ?thesis by simp
    next
      case (Cons x' xs')
      with a#as = xs@ys have "a = x'" and "as = xs'@ys" by simp_all
      with ‹upd_cs cs xs = [] Cons kind a = Qpf cs = c'#cs'
      have "upd_cs cs' xs' = []" by simp
      from IH2[OF as = xs'@ys this] show ?thesis .
    qed
  }
qed


lemma slpa_number_Calls_eq_number_Returns:
  "same_level_path_aux cs as; upd_cs cs as = []; 
    a  set as. valid_edge a; c  set cs. valid_edge c
   length [aas@cs. Q r p fs. kind a = Q:rpfs] = 
     length [aas. Q p f. kind a = Qpf]"
apply(induct rule:slpa_induct)
by(auto split:list.split edge_kind.split intro:only_call_get_return_edges 
         simp:intra_kind_def)


lemma slpa_get_proc:
  "same_level_path_aux cs as; upd_cs cs as = []; n -as→* n'; 
    c  set cs. valid_edge c
   (if cs = [] then get_proc n else get_proc(last(sourcenodes cs))) = get_proc n'"
proof(induct arbitrary:n rule:slpa_induct)
  case slpa_empty thus ?case by fastforce
next
  case (slpa_intra cs a as)
  note IH = n. upd_cs cs as = []; n -as→* n'; aset cs. valid_edge a
     (if cs = [] then get_proc n else get_proc (last (sourcenodes cs))) = 
        get_proc n'
  from ‹intra_kind (kind a) ‹upd_cs cs (a#as) = []
  have "upd_cs cs as = []" by(cases "kind a",auto simp:intra_kind_def)
  from n -a#as→* n' have "n -[]@a#as→* n'" by simp
  hence "valid_edge a" and "n = sourcenode a" and "targetnode a -as→* n'"
    by(fastforce dest:path_split)+
  from valid_edge a ‹intra_kind (kind a) n = sourcenode a
  have "get_proc n = get_proc (targetnode a)"
    by(fastforce intro:get_proc_intra)
  from IH[OF ‹upd_cs cs as = [] targetnode a -as→* n' aset cs. valid_edge a]
  have "(if cs = [] then get_proc (targetnode a) 
         else get_proc (last (sourcenodes cs))) = get_proc n'" .
  with get_proc n = get_proc (targetnode a) show ?case by auto
next
  case (slpa_Call cs a as Q r p fs)
  note IH = n. upd_cs (a#cs) as = []; n -as→* n'; aset (a#cs). valid_edge a
     (if a#cs = [] then get_proc n else get_proc (last (sourcenodes (a#cs)))) = 
        get_proc n'
  from kind a = Q:rpfs ‹upd_cs cs (a#as) = []
  have "upd_cs (a#cs) as = []" by simp
  from n -a#as→* n' have "n -[]@a#as→* n'" by simp
  hence "valid_edge a" and "n = sourcenode a" and "targetnode a -as→* n'"
    by(fastforce dest:path_split)+
  from valid_edge a aset cs. valid_edge a have "aset (a#cs). valid_edge a"
    by simp
  from IH[OF ‹upd_cs (a#cs) as = [] targetnode a -as→* n' this]
  have "get_proc (last (sourcenodes (a#cs))) = get_proc n'" by simp
  with n = sourcenode a show ?case by(cases cs,auto simp:sourcenodes_def)
next
  case (slpa_Return cs a as Q p f c' cs')
  note IH = n. upd_cs cs' as = []; n -as→* n'; aset cs'. valid_edge a
     (if cs' = [] then get_proc n else get_proc (last (sourcenodes cs'))) = 
       get_proc n'
  from aset cs. valid_edge a cs = c'#cs'
  have "valid_edge c'" and "aset cs'. valid_edge a" by simp_all
  from kind a = Qpf ‹upd_cs cs (a#as) = [] cs = c'#cs'
  have "upd_cs cs' as = []" by simp
  from n -a#as→* n' have "n -[]@a#as→* n'" by simp
  hence "n = sourcenode a" and "targetnode a -as→* n'"
    by(fastforce dest:path_split)+
  from valid_edge c' a  get_return_edges c'
  have "get_proc (sourcenode c') = get_proc (targetnode a)"
    by(rule get_proc_get_return_edge)
  from IH[OF ‹upd_cs cs' as = [] targetnode a -as→* n' aset cs'. valid_edge a]
  have "(if cs' = [] then get_proc (targetnode a) 
         else get_proc (last (sourcenodes cs'))) = get_proc n'" .
  with cs = c'#cs' get_proc (sourcenode c') = get_proc (targetnode a)
  show ?case by(auto simp:sourcenodes_def)
qed


lemma slpa_get_return_edges:
  "same_level_path_aux cs as; cs  []; upd_cs cs as = [];
  xs ys. as = xs@ys  ys  []  upd_cs cs xs  []
   last as  get_return_edges (last cs)"
proof(induct rule:slpa_induct)
  case (slpa_empty cs)
  from cs  [] ‹upd_cs cs [] = [] have False by fastforce
  thus ?case by simp
next
  case (slpa_intra cs a as)
  note IH = cs  []; upd_cs cs as = []; 
              xs ys. as = xs@ys  ys  []  upd_cs cs xs  []
     last as  get_return_edges (last cs)
  show ?case
  proof(cases "as = []")
    case True
    with ‹intra_kind (kind a) ‹upd_cs cs (a#as) = [] have "cs = []"
      by(fastforce simp:intra_kind_def)
    with cs  [] have False by simp
    thus ?thesis by simp
  next
    case False
    from ‹intra_kind (kind a) ‹upd_cs cs (a#as) = [] have "upd_cs cs as = []"
      by(fastforce simp:intra_kind_def)
    from xs ys. a#as = xs@ys  ys  []  upd_cs cs xs  [] ‹intra_kind (kind a)
    have "xs ys. as = xs@ys  ys  []  upd_cs cs xs  []"
      apply(clarsimp,erule_tac x="a#xs" in allE)
      by(auto simp:intra_kind_def)
    from IH[OF cs  [] ‹upd_cs cs as = [] this] 
    have "last as  get_return_edges (last cs)" .
    with False show ?thesis by simp
  qed
next
  case (slpa_Call cs a as Q r p fs)
  note IH = a#cs  []; upd_cs (a#cs) as = [];
    xs ys. as = xs@ys  ys  []  upd_cs (a#cs) xs  []
     last as  get_return_edges (last (a#cs))
  show ?case
  proof(cases "as = []")
    case True
    with kind a = Q:rpfs ‹upd_cs cs (a#as) = [] have "a#cs = []" by simp
    thus ?thesis by simp
  next
    case False
    from kind a = Q:rpfs ‹upd_cs cs (a#as) = [] have "upd_cs (a#cs) as = []"
      by simp
    from xs ys. a#as = xs@ys  ys  []  upd_cs cs xs  [] kind a = Q:rpfs
    have "xs ys. as = xs@ys  ys  []  upd_cs (a#cs) xs  []"
      by(clarsimp,erule_tac x="a#xs" in allE,simp)
    from IH[OF _ ‹upd_cs (a#cs) as = [] this] 
    have "last as  get_return_edges (last (a#cs))" by simp
    with False cs  [] show ?thesis by(simp add:targetnodes_def)
  qed
next
  case (slpa_Return cs a as Q p f c' cs')
  note IH = cs'  []; upd_cs cs' as = []; 
    xs ys. as = xs@ys  ys  []  upd_cs cs' xs  []
     last as  get_return_edges (last cs')
  show ?case
  proof(cases "as = []")
    case True
    with kind a = Qpf cs = c'#cs' ‹upd_cs cs (a#as) = []
    have "cs' = []" by simp
    with cs = c'#cs' a  get_return_edges c' True
    show ?thesis by simp
  next
    case False
    from kind a = Qpf cs = c'#cs' ‹upd_cs cs (a#as) = []
    have "upd_cs cs' as = []" by simp
    show ?thesis
    proof(cases "cs' = []")
      case True
      with cs = c'#cs' kind a = Qpf have "upd_cs cs [a] = []" by simp
      with xs ys. a#as = xs@ys  ys  []  upd_cs cs xs  [] False have False
        apply(erule_tac x="[a]" in allE) by fastforce
      thus ?thesis by simp
    next
      case False
      from xs ys. a#as = xs@ys  ys  []  upd_cs cs xs  []
        kind a = Qpf cs = c'#cs'
      have "xs ys. as = xs@ys  ys  []  upd_cs cs' xs  []"
        by(clarsimp,erule_tac x="a#xs" in allE,simp)
      from IH[OF False ‹upd_cs cs' as = [] this]
      have "last as  get_return_edges (last cs')" .
      with as  [] False cs = c'#cs' show ?thesis by(simp add:targetnodes_def)
    qed
  qed
qed


lemma slpa_callstack_length:
  assumes "same_level_path_aux cs as" and "length cs = length cfsx"
  obtains cfx cfsx' where "transfers (kinds as) (cfsx@cf#cfs) = cfsx'@cfx#cfs"
  and "transfers (kinds as) (cfsx@cf#cfs') = cfsx'@cfx#cfs'"
  and "length cfsx' = length (upd_cs cs as)"
proof(atomize_elim)
  from assms show "cfsx' cfx. transfers (kinds as) (cfsx@cf#cfs) = cfsx'@cfx#cfs 
    transfers (kinds as) (cfsx@cf#cfs') = cfsx'@cfx#cfs' 
    length cfsx' = length (upd_cs cs as)"
  proof(induct arbitrary:cfsx cf rule:slpa_induct)
    case (slpa_empty cs) thus ?case by(simp add:kinds_def)
  next
    case (slpa_intra cs a as)
    note IH = cfsx cf. length cs = length cfsx 
      cfsx' cfx. transfers (kinds as) (cfsx@cf#cfs) = cfsx'@cfx#cfs 
                  transfers (kinds as) (cfsx@cf#cfs') = cfsx'@cfx#cfs' 
                  length cfsx' = length (upd_cs cs as)
    from ‹intra_kind (kind a) 
    have "length (upd_cs cs (a#as)) = length (upd_cs cs as)"
      by(fastforce simp:intra_kind_def)
    show ?case
    proof(cases cfsx)
      case Nil
      with ‹length cs = length cfsx have "length cs = length []" by simp
      from Nil ‹intra_kind (kind a) 
      obtain cfx where transfer:"transfer (kind a) (cfsx@cf#cfs) = []@cfx#cfs"
        "transfer (kind a) (cfsx@cf#cfs') = []@cfx#cfs'"
        by(cases "kind a",auto simp:kinds_def intra_kind_def)
      from IH[OF ‹length cs = length []] obtain cfsx' cfx' 
        where "transfers (kinds as) ([]@cfx#cfs) = cfsx'@cfx'#cfs"
        and "transfers (kinds as) ([]@cfx#cfs') = cfsx'@cfx'#cfs'"
        and "length cfsx' = length (upd_cs cs as)" by blast
      with ‹length (upd_cs cs (a#as)) = length (upd_cs cs as) transfer
      show ?thesis by(fastforce simp:kinds_def)
    next
      case (Cons x xs)
      with ‹intra_kind (kind a) obtain cfx' 
        where transfer:"transfer (kind a) (cfsx@cf#cfs) = (cfx'#xs)@cf#cfs"
        "transfer (kind a) (cfsx@cf#cfs') = (cfx'#xs)@cf#cfs'"
        by(cases "kind a",auto simp:kinds_def intra_kind_def)
      from ‹length cs = length cfsx Cons have "length cs = length (cfx'#xs)"
        by simp
      from IH[OF this] obtain cfs'' cf''
        where "transfers (kinds as) ((cfx'#xs)@cf#cfs) = cfs''@cf''#cfs"
        and "transfers (kinds as) ((cfx'#xs)@cf#cfs') = cfs''@cf''#cfs'"
        and "length cfs'' = length (upd_cs cs as)" by blast
      with ‹length (upd_cs cs (a#as)) = length (upd_cs cs as) transfer
      show ?thesis by(fastforce simp:kinds_def)
    qed
  next
    case (slpa_Call cs a as Q r p fs)
    note IH = cfsx cf. length (a#cs) = length cfsx 
      cfsx' cfx. transfers (kinds as) (cfsx@cf#cfs) = cfsx'@cfx#cfs 
                  transfers (kinds as) (cfsx@cf#cfs') = cfsx'@cfx#cfs' 
                  length cfsx' = length (upd_cs (a#cs) as)
    from kind a = Q:rpfs
    obtain cfx where transfer:"transfer (kind a) (cfsx@cf#cfs) = (cfx#cfsx)@cf#cfs"
      "transfer (kind a) (cfsx@cf#cfs') = (cfx#cfsx)@cf#cfs'"
      by(cases cfsx) auto
    from ‹length cs = length cfsx have "length (a#cs) = length (cfx#cfsx)"
      by simp
    from IH[OF this] obtain cfsx' cfx' 
      where "transfers (kinds as) ((cfx#cfsx)@cf#cfs) = cfsx'@cfx'#cfs"
      and "transfers (kinds as) ((cfx#cfsx)@cf#cfs') = cfsx'@cfx'#cfs'"
      and "length cfsx' = length (upd_cs (a#cs) as)" by blast
    with kind a = Q:rpfs transfer show ?case by(fastforce simp:kinds_def)
  next
     case (slpa_Return cs a as Q p f c' cs')
     note IH = cfsx cf. length cs' = length cfsx 
       cfsx' cfx. transfers (kinds as) (cfsx@cf#cfs) = cfsx'@cfx#cfs 
                   transfers (kinds as) (cfsx@cf#cfs') = cfsx'@cfx#cfs' 
                   length cfsx' = length (upd_cs cs' as)
     from kind a = Qpf cs = c'#cs'
     have "length (upd_cs cs (a#as)) = length (upd_cs cs' as)" by simp
     show ?case
     proof(cases cs')
       case Nil
       with cs = c'#cs' ‹length cs = length cfsx obtain cfx
         where [simp]:"cfsx = [cfx]" by(cases cfsx) auto
       with kind a = Qpf obtain cf' 
         where transfer:"transfer (kind a) (cfsx@cf#cfs) = []@cf'#cfs"
         "transfer (kind a) (cfsx@cf#cfs') = []@cf'#cfs'"
         by fastforce
       from Nil have "length cs' = length []" by simp
       from IH[OF this] obtain cfsx' cfx' 
         where "transfers (kinds as) ([]@cf'#cfs) = cfsx'@cfx'#cfs"
         and "transfers (kinds as) ([]@cf'#cfs') = cfsx'@cfx'#cfs'"
         and "length cfsx' = length (upd_cs cs' as)" by blast
       with ‹length (upd_cs cs (a#as)) = length (upd_cs cs' as) transfer
       show ?thesis by(fastforce simp:kinds_def)
    next
      case (Cons cx csx)
      with cs = c'#cs' ‹length cs = length cfsx obtain x x' xs
        where [simp]:"cfsx = x#x'#xs" and "length xs = length csx"
        by(cases cfsx,auto,case_tac list,fastforce+)
      with kind a = Qpf obtain cf' 
        where transfer:"transfer (kind a) ((x#x'#xs)@cf#cfs) = (cf'#xs)@cf#cfs"
        "transfer (kind a) ((x#x'#xs)@cf#cfs') = (cf'#xs)@cf#cfs'"
        by fastforce
      from cs = c'#cs' ‹length cs = length cfsx have "length cs' = length (cf'#xs)"
        by simp
      from IH[OF this] obtain cfsx' cfx 
        where "transfers (kinds as) ((cf'#xs)@cf#cfs) = cfsx'@cfx#cfs"
        and "transfers (kinds as) ((cf'#xs)@cf#cfs') = cfsx'@cfx#cfs'"
        and "length cfsx' = length (upd_cs cs' as)" by blast
      with ‹length (upd_cs cs (a#as)) = length (upd_cs cs' as) transfer
      show ?thesis by(fastforce simp:kinds_def)
    qed
  qed
qed


lemma slpa_snoc_intra:
  "same_level_path_aux cs as; intra_kind (kind a) 
   same_level_path_aux cs (as@[a])"
by(induct rule:slpa_induct,auto simp:intra_kind_def)


lemma slpa_snoc_Call:
  "same_level_path_aux cs as; kind a = Q:rpfs
   same_level_path_aux cs (as@[a])"
by(induct rule:slpa_induct,auto simp:intra_kind_def)


lemma vpa_Main_slpa:
  "valid_path_aux cs as; m -as→* m'; as  []; 
    valid_call_list cs m; get_proc m' = Main;
    get_proc (case cs of []  m | _  sourcenode (last cs)) = Main
   same_level_path_aux cs as  upd_cs cs as = []"
proof(induct arbitrary:m rule:vpa_induct)
  case (vpa_empty cs) thus ?case by simp
next
  case (vpa_intra cs a as)
  note IH = m. m -as→* m'; as  []; valid_call_list cs m; get_proc m' = Main;
    get_proc (case cs of []  m | a # list  sourcenode (last cs)) = Main
     same_level_path_aux cs as  upd_cs cs as = []
  from m -a # as→* m' have "sourcenode a = m" and "valid_edge a"
    and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
  from valid_edge a ‹intra_kind (kind a) 
  have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
  show ?case
  proof(cases "as = []")
    case True
    with targetnode a -as→* m' have "targetnode a = m'" by fastforce
    with get_proc (sourcenode a) = get_proc (targetnode a) 
      sourcenode a = m get_proc m' = Main
    have "get_proc m = Main" by simp
    have "cs = []"
    proof(cases cs)
      case Cons
      with ‹valid_call_list cs m
      obtain c Q r p fs where "valid_edge c" and "kind c = Q:rget_proc mfs"
        by(auto simp:valid_call_list_def,erule_tac x="[]" in allE,
           auto simp:sourcenodes_def)
      with get_proc m = Main have "kind c = Q:rMainfs" by simp
      with valid_edge c have False by(rule Main_no_call_target)
      thus ?thesis by simp
    qed simp
    with True ‹intra_kind (kind a) show ?thesis by(fastforce simp:intra_kind_def)
  next
    case False
    from ‹valid_call_list cs m sourcenode a = m
      get_proc (sourcenode a) = get_proc (targetnode a)
    have "valid_call_list cs (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(erule_tac x="cs'" in allE)
      apply(erule_tac x="c" in allE)
      by(auto split:list.split)
    from get_proc (case cs of []  m | _  sourcenode (last cs)) = Main
      sourcenode a = m get_proc (sourcenode a) = get_proc (targetnode a)
    have "get_proc (case cs of []  targetnode a | _  sourcenode (last cs)) = Main"
      by(cases cs) auto
    from IH[OF targetnode a -as→* m' False ‹valid_call_list cs (targetnode a)
      get_proc m' = Main this]
    have "same_level_path_aux cs as  upd_cs cs as = []" .
    with ‹intra_kind (kind a) show ?thesis by(fastforce simp:intra_kind_def)
  qed
next
  case (vpa_Call cs a as Q r p fs)
  note IH = m. m -as→* m'; as  []; valid_call_list (a # cs) m; 
    get_proc m' = Main; 
    get_proc (case a # cs of []  m | _  sourcenode (last (a # cs))) = Main
     same_level_path_aux (a # cs) as  upd_cs (a # cs) as = []
  from m -a # as→* m' have "sourcenode a = m" and "valid_edge a"
    and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
  from valid_edge a kind a = Q:rpfs have "get_proc (targetnode a) = p"
    by(rule get_proc_call)
  show ?case
  proof(cases "as = []")
    case True
    with targetnode a -as→* m' have "targetnode a = m'" by fastforce
    with get_proc (targetnode a) = p get_proc m' = Main kind a = Q:rpfs
    have "kind a = Q:rMainfs" by simp
    with valid_edge a have False by(rule Main_no_call_target)
    thus ?thesis by simp
  next
    case False
    from get_proc (targetnode a) = p ‹valid_call_list cs m valid_edge a
      kind a = Q:rpfs sourcenode a = m
    have "valid_call_list (a # cs) (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(case_tac cs') apply auto
      apply(erule_tac x="list" in allE)
      by(case_tac list)(auto simp:sourcenodes_def)
    from get_proc (case cs of []  m | _  sourcenode (last cs)) = Main
      sourcenode a = m
    have "get_proc (case a # cs of []  targetnode a 
      | _  sourcenode (last (a # cs))) = Main"
      by(cases cs) auto
    from IH[OF targetnode a -as→* m' False ‹valid_call_list (a#cs) (targetnode a)
      get_proc m' = Main this]
    have "same_level_path_aux (a # cs) as  upd_cs (a # cs) as = []" .
    with kind a = Q:rpfs show ?thesis by simp
  qed
next
  case (vpa_ReturnEmpty cs a as Q p f)
  note IH = m. m -as→* m'; as  []; valid_call_list [] m; get_proc m' = Main;
    get_proc (case [] of []  m | a # list  sourcenode (last [])) = Main
     same_level_path_aux [] as  upd_cs [] as = []
  from m -a # as→* m' have "sourcenode a = m" and "valid_edge a"
    and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
  from valid_edge a kind a = Qpf have "get_proc (sourcenode a) = p" 
    by(rule get_proc_return)
  from get_proc (case cs of []  m | a # list  sourcenode (last cs)) = Main
    cs = []
  have "get_proc m = Main" by simp
  with sourcenode a = m get_proc (sourcenode a) = p have "p = Main" by simp
  with kind a = Qpf have "kind a = QMainf" by simp
  with valid_edge a have False by(rule Main_no_return_source)
  thus ?case by simp
next
  case (vpa_ReturnCons cs a as Q p f c' cs')
  note IH = m. m -as→* m'; as  []; valid_call_list cs' m; get_proc m' = Main;
    get_proc (case cs' of []  m | a # list  sourcenode (last cs')) = Main
     same_level_path_aux cs' as  upd_cs cs' as = []
  from m -a # as→* m' have "sourcenode a = m" and "valid_edge a"
    and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
  from valid_edge a kind a = Qpf have "get_proc (sourcenode a) = p" 
    by(rule get_proc_return)
  from ‹valid_call_list cs m cs = c' # cs'
  have "valid_edge c'" 
    by(auto simp:valid_call_list_def,erule_tac x="[]" in allE,auto)
  from valid_edge c' a  get_return_edges c'
  have "get_proc (sourcenode c') = get_proc (targetnode a)"
    by(rule get_proc_get_return_edge)
  show ?case
  proof(cases "as = []")
    case True
    with targetnode a -as→* m' have "targetnode a = m'" by fastforce
    with get_proc m' = Main have "get_proc (targetnode a) = Main" by simp
    from get_proc (sourcenode c') = get_proc (targetnode a)
      get_proc (targetnode a) = Main
    have "get_proc (sourcenode c') = Main" by simp
    have "cs' = []"
    proof(cases cs')
      case (Cons cx csx)
      with cs = c' # cs' ‹valid_call_list cs m
      obtain Qx rx fsx where "valid_edge cx" 
        and "kind cx = Qx:rxget_proc (sourcenode c')fsx"
        by(auto simp:valid_call_list_def,erule_tac x="[c']" in allE,
           auto simp:sourcenodes_def)
      with get_proc (sourcenode c') = Main have "kind cx = Qx:rxMainfsx" by simp
      with valid_edge cx have False by(rule Main_no_call_target)
      thus ?thesis by simp
    qed simp
    with True cs = c' # cs' a  get_return_edges c' kind a = Qpf
    show ?thesis by simp
  next
    case False
    from ‹valid_call_list cs m cs = c' # cs'
      get_proc (sourcenode c') = get_proc (targetnode a)
    have "valid_call_list cs' (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(hypsubst_thin)
      apply(erule_tac x="c' # cs'" in allE)
      by(case_tac cs')(auto simp:sourcenodes_def)
    from get_proc (case cs of []  m | a # list  sourcenode (last cs)) = Main
      cs = c' # cs' get_proc (sourcenode c') = get_proc (targetnode a)
    have "get_proc (case cs' of []  targetnode a 
      | _  sourcenode (last cs')) = Main"
      by(cases cs') auto
    from IH[OF targetnode a -as→* m' False ‹valid_call_list cs' (targetnode a)
      get_proc m' = Main this]
    have "same_level_path_aux cs' as  upd_cs cs' as = []" .
    with kind a = Qpf cs = c' # cs' a  get_return_edges c'
    show ?thesis by simp
  qed
qed



definition same_level_path :: "'edge list  bool"
  where "same_level_path as  same_level_path_aux [] as  upd_cs [] as = []"


lemma same_level_path_valid_path:
  "same_level_path as  valid_path as"
by(fastforce intro:same_level_path_aux_valid_path_aux
             simp:same_level_path_def valid_path_def)


lemma same_level_path_Append:
  "same_level_path as; same_level_path as'  same_level_path (as@as')"
by(fastforce elim:same_level_path_aux_Append upd_cs_Append simp:same_level_path_def)


lemma same_level_path_number_Calls_eq_number_Returns:
  "same_level_path as; a  set as. valid_edge a  
  length [aas. Q r p fs. kind a = Q:rpfs] = length [aas. Q p f. kind a = Qpf]"
by(fastforce dest:slpa_number_Calls_eq_number_Returns simp:same_level_path_def)


lemma same_level_path_valid_path_Append:
  "same_level_path as; valid_path as'  valid_path (as@as')"
  by(fastforce intro:valid_path_aux_Append elim:same_level_path_aux_valid_path_aux
               simp:valid_path_def same_level_path_def)

lemma valid_path_same_level_path_Append:
  "valid_path as; same_level_path as'  valid_path (as@as')"
  apply(auto simp:valid_path_def same_level_path_def)
  apply(erule valid_path_aux_Append)
  by(fastforce intro!:same_level_path_aux_valid_path_aux 
                dest:same_level_path_aux_callstack_Append)

lemma intras_same_level_path:
  assumes "a  set as. intra_kind(kind a)" shows "same_level_path as"
proof -
  from a  set as. intra_kind(kind a) have "same_level_path_aux [] as"
    by(induct as)(auto simp:intra_kind_def)
  moreover
  from a  set as. intra_kind(kind a) have "upd_cs [] as = []"
    by(induct as)(auto simp:intra_kind_def)
  ultimately show ?thesis by(simp add:same_level_path_def)
qed


definition same_level_path' :: "'node  'edge list  'node  bool" 
  ("_ -_sl* _" [51,0,0] 80)
where slp_def:"n -assl* n'  n -as→* n'  same_level_path as"

lemma slp_vp: "n -assl* n'  n -as* n'"
by(fastforce intro:same_level_path_valid_path simp:slp_def vp_def)


lemma intra_path_slp: "n -asι* n'  n -assl* n'"
by(fastforce intro:intras_same_level_path simp:slp_def intra_path_def)


lemma slp_Append:
  "n -assl* n''; n'' -as'sl* n'  n -as@as'sl* n'"
  by(fastforce simp:slp_def intro:path_Append same_level_path_Append)


lemma slp_vp_Append:
  "n -assl* n''; n'' -as'* n'  n -as@as'* n'"
  by(fastforce simp:slp_def vp_def intro:path_Append same_level_path_valid_path_Append)


lemma vp_slp_Append:
  "n -as* n''; n'' -as'sl* n'  n -as@as'* n'"
  by(fastforce simp:slp_def vp_def intro:path_Append valid_path_same_level_path_Append)


lemma slp_get_proc:
  "n -assl* n'  get_proc n = get_proc n'"
by(fastforce dest:slpa_get_proc simp:same_level_path_def slp_def)


lemma same_level_path_inner_path:
  assumes "n -assl* n'"
  obtains as' where "n -as'ι* n'" and "set(sourcenodes as')  set(sourcenodes as)"
proof(atomize_elim)
  from n -assl* n' have "n -as→* n'" and "same_level_path as"
    by(simp_all add:slp_def)
  from ‹same_level_path as have "same_level_path_aux [] as" and "upd_cs [] as = []"
    by(simp_all add:same_level_path_def)
  from n -as→* n' ‹same_level_path_aux [] as ‹upd_cs [] as = []
  show "as'. n -as'ι* n'  set(sourcenodes as')  set(sourcenodes as)"
  proof(induct as arbitrary:n rule:length_induct)
    fix as n
    assume IH:"as''. length as'' < length as 
      (n''. n'' -as''→* n'  same_level_path_aux [] as'' 
           upd_cs [] as'' = [] 
           (as'. n'' -as'ι* n'  set (sourcenodes as')  set (sourcenodes as'')))"
      and "n -as→* n'" and "same_level_path_aux [] as" and "upd_cs [] as = []"
    show "as'. n -as'ι* n'  set (sourcenodes as')  set (sourcenodes as)"
    proof(cases as)
      case Nil
      with n -as→* n' show ?thesis by(fastforce simp:intra_path_def)
    next
      case (Cons a' as')
      with n -as→* n' Cons have "n = sourcenode a'" and "valid_edge a'" 
        and "targetnode a' -as'→* n'"
        by(auto intro:path_split_Cons)
      show ?thesis
      proof(cases "kind a'" rule:edge_kind_cases)
        case Intra
        with Cons ‹same_level_path_aux [] as have "same_level_path_aux [] as'"
          by(fastforce simp:intra_kind_def)
        moreover
        from Intra Cons ‹upd_cs [] as = [] have "upd_cs [] as' = []"
          by(fastforce simp:intra_kind_def)
        ultimately obtain as'' where "targetnode a' -as''ι* n'"
          and "set (sourcenodes as'')  set (sourcenodes as')"
          using IH Cons targetnode a' -as'→* n'
          by(erule_tac x="as'" in allE) auto
        from n = sourcenode a' valid_edge a' Intra targetnode a' -as''ι* n'
        have "n -a'#as''ι* n'" by(fastforce intro:Cons_path simp:intra_path_def)
        with ‹set (sourcenodes as'')  set (sourcenodes as') Cons show ?thesis
          by(rule_tac x="a'#as''" in exI,auto simp:sourcenodes_def)
      next
        case (Call Q p f)
        with Cons ‹same_level_path_aux [] as
        have "same_level_path_aux [a'] as'" by simp
        from Call Cons ‹upd_cs [] as = [] have "upd_cs [a'] as' = []" by simp
        hence "as'  []" by fastforce
        with ‹upd_cs [a'] as' = [] obtain xs ys where "as' = xs@ys" and "xs  []"
        and "upd_cs [a'] xs = []" and "upd_cs [] ys = []"
        and "xs' ys'. xs = xs'@ys'  ys'  []  upd_cs [a'] xs'  []"
          by -(erule upd_cs_empty_split,auto)
        from ‹same_level_path_aux [a'] as' as' = xs@ys ‹upd_cs [a'] xs = []
        have "same_level_path_aux [a'] xs" and "same_level_path_aux [] ys"
          by(auto intro:slpa_split)
        from ‹same_level_path_aux [a'] xs ‹upd_cs [a'] xs = []
          xs' ys'. xs = xs'@ys'  ys'  []  upd_cs [a'] xs'  []
        have "last xs  get_return_edges (last [a'])"
          by(fastforce intro!:slpa_get_return_edges)
        with valid_edge a' Call
        obtain a where "valid_edge a" and "sourcenode a = sourcenode a'"
          and "targetnode a = targetnode (last xs)" and "kind a = (λcf. False)"
          by -(drule call_return_node_edge,auto)
        from targetnode a = targetnode (last xs) xs  []
        have "targetnode a = targetnode (last (a'#xs))" by simp
        from as' = xs@ys xs  [] Cons have "length ys < length as" by simp
        from targetnode a' -as'→* n' as' = xs@ys xs  []
        have "targetnode (last (a'#xs)) -ys→* n'"
          by(cases xs rule:rev_cases,auto dest:path_split)
        with IH ‹length ys < length as ‹same_level_path_aux [] ys
          ‹upd_cs [] ys = []
        obtain as'' where "targetnode (last (a'#xs)) -as''ι* n'"
          and "set(sourcenodes as'')  set(sourcenodes ys)"
          apply(erule_tac x="ys" in allE) apply clarsimp
          apply(erule_tac x="targetnode (last (a'#xs))" in allE) 
          by clarsimp
        from sourcenode a = sourcenode a' n = sourcenode a'
          targetnode a = targetnode (last (a'#xs)) valid_edge a
          kind a = (λcf. False) targetnode (last (a'#xs)) -as''ι* n'
        have "n -a#as''ι* n'"
          by(fastforce intro:Cons_path simp:intra_path_def intra_kind_def)
        moreover
        from ‹set(sourcenodes as'')  set(sourcenodes ys) Cons as' = xs@ys
          sourcenode a = sourcenode a'
        have "set(sourcenodes (a#as''))  set(sourcenodes as)"
          by(auto simp:sourcenodes_def)
        ultimately show ?thesis by blast
      next
        case (Return Q p f)
        with Cons ‹same_level_path_aux [] as have False by simp
        thus ?thesis by simp
      qed
    qed
  qed
qed


lemma slp_callstack_length_equal:
  assumes "n -assl* n'" obtains cf' where "transfers (kinds as) (cf#cfs) = cf'#cfs"
  and "transfers (kinds as) (cf#cfs') = cf'#cfs'"
proof(atomize_elim)
  from n -assl* n' have "same_level_path_aux [] as" and "upd_cs [] as = []"
    by(simp_all add:slp_def same_level_path_def)
  then obtain cfx cfsx where "transfers (kinds as) (cf#cfs) = cfsx@cfx#cfs"
    and "transfers (kinds as) (cf#cfs') = cfsx@cfx#cfs'"
    and "length cfsx = length (upd_cs [] as)"
    by(fastforce elim:slpa_callstack_length)
  with ‹upd_cs [] as = [] have "cfsx = []" by(cases cfsx) auto
  with ‹transfers (kinds as) (cf#cfs) = cfsx@cfx#cfs
    ‹transfers (kinds as) (cf#cfs') = cfsx@cfx#cfs'
  show "cf'. transfers (kinds as) (cf#cfs) = cf'#cfs  
    transfers (kinds as) (cf#cfs') = cf'#cfs'" by fastforce
qed


lemma slp_cases [consumes 1,case_names intra_path return_intra_path]:
  assumes "m -assl* m'"
  obtains "m -asι* m'"
  | as' a as'' Q p f where "as = as'@a#as''" and "kind a = Qpf"
  and "m -as'@[a]sl* targetnode a" and "targetnode a -as''ι* m'"
proof(atomize_elim)
  from m -assl* m' have "m -as→* m'" and "same_level_path_aux [] as"
    and "upd_cs [] as = []" by(simp_all add:slp_def same_level_path_def)
  from m -as→* m' have "a  set as. valid_edge a" by(rule path_valid_edges)
  have "a  set []. valid_edge a" by simp
  with ‹same_level_path_aux [] as ‹upd_cs [] as = [] a  set []. valid_edge a
    a  set as. valid_edge a
  show "m -asι* m' 
    (as' a as'' Q p f. as = as' @ a # as''  kind a = Qpf 
    m -as' @ [a]sl* targetnode a  targetnode a -as''ι* m')"
  proof(cases rule:slpa_cases)
    case intra_path
    with m -as→* m' have "m -asι* m'" by(simp add:intra_path_def)
    thus ?thesis by blast
  next
    case (return_intra_path as' a as'' Q p f c' cs')
    from m -as→* m' as = as' @ a # as''
    have "m -as'→* sourcenode a" and "valid_edge a" and "targetnode a -as''→* m'"
      by(auto intro:path_split)
    from m -as'→* sourcenode a valid_edge a
    have "m -as'@[a]→* targetnode a" by(fastforce intro:path_Append path_edge)
    with ‹same_level_path_aux [] as' ‹upd_cs [] as' = c' # cs' kind a = Qpf
      a  get_return_edges c'
    have "same_level_path_aux [] (as'@[a])"
      by(fastforce intro:same_level_path_aux_Append)
    with ‹upd_cs [] (as' @ [a]) = [] m -as'@[a]→* targetnode a
    have "m -as'@[a]sl* targetnode a" by(simp add:slp_def same_level_path_def)
    moreover
    from aset as''. intra_kind (kind a) targetnode a -as''→* m'
    have "targetnode a -as''ι* m'" by(simp add:intra_path_def)
    ultimately show ?thesis using as = as' @ a # as'' kind a = Qpf by blast
  qed
qed


function same_level_path_rev_aux :: "'edge list  'edge list  bool"
  where "same_level_path_rev_aux cs []  True"
  | "same_level_path_rev_aux cs (as@[a])  
       (case (kind a) of Qpf  same_level_path_rev_aux (a#cs) as
                       | Q:rpfs  case cs of []  False
                                     | c'#cs'  c'  get_return_edges a 
                                             same_level_path_rev_aux cs' as
                       |    _  same_level_path_rev_aux cs as)"
by auto(case_tac b rule:rev_cases,auto)
termination by lexicographic_order


lemma slpra_induct [consumes 1,case_names slpra_empty slpra_intra slpra_Return
  slpra_Call]:
  assumes major: "same_level_path_rev_aux xs ys"
  and rules: "cs. P cs []"
    "cs a as. intra_kind(kind a); same_level_path_rev_aux cs as; P cs as 
       P cs (as@[a])"
    "cs a as Q p f. kind a = Qpf; same_level_path_rev_aux (a#cs) as; P (a#cs) as 
       P cs (as@[a])"
    "cs a as Q r p fs c' cs'. kind a = Q:rpfs; cs = c'#cs'; 
                   same_level_path_rev_aux cs' as; c'  get_return_edges a; P cs' as
      P cs (as@[a])"
  shows "P xs ys"
using major
apply(induct ys arbitrary: xs rule:rev_induct)
by(auto intro:rules split:edge_kind.split_asm list.split_asm simp:intra_kind_def)


lemma same_level_path_rev_aux_Append:
  "same_level_path_rev_aux cs as'; same_level_path_rev_aux (upd_rev_cs cs as') as
   same_level_path_rev_aux cs (as@as')"
by(induct rule:slpra_induct,
   auto simp:intra_kind_def simp del:append_assoc simp:append_assoc[THEN sym])


lemma slpra_to_slpa:
  "same_level_path_rev_aux cs as; upd_rev_cs cs as = []; n -as→* n'; 
  valid_return_list cs n'
   same_level_path_aux [] as  same_level_path_aux (upd_cs [] as) cs 
     upd_cs (upd_cs [] as) cs = []"
proof(induct arbitrary:n' rule:slpra_induct)
  case slpra_empty thus ?case by simp
next
  case (slpra_intra cs a as)
  note IH = n'. upd_rev_cs cs as = []; n -as→* n'; valid_return_list cs n'
     same_level_path_aux [] as  same_level_path_aux (upd_cs [] as) cs 
       upd_cs (upd_cs [] as) cs = []
  from n -as@[a]→* n' have "n -as→* sourcenode a" and "valid_edge a"
    and "n' = targetnode a" by(auto intro:path_split_snoc)
  from valid_edge a ‹intra_kind (kind a)
  have "get_proc (sourcenode a) = get_proc (targetnode a)"
    by(rule get_proc_intra)
  with ‹valid_return_list cs n' n' = targetnode a
  have "valid_return_list cs (sourcenode a)"
    apply(clarsimp simp:valid_return_list_def)
    apply(erule_tac x="cs'" in allE) apply clarsimp
    by(case_tac cs')(auto simp:targetnodes_def)
  from ‹upd_rev_cs cs (as@[a]) = [] ‹intra_kind (kind a)
  have "upd_rev_cs cs as = []" by(fastforce simp:intra_kind_def)
  from valid_edge a ‹intra_kind (kind a)
  have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
  from IH[OF ‹upd_rev_cs cs as = [] n -as→* sourcenode a
    ‹valid_return_list cs (sourcenode a)]
  have "same_level_path_aux [] as" 
    and "same_level_path_aux (upd_cs [] as) cs"
    and "upd_cs (upd_cs [] as) cs = []" by simp_all
  from ‹same_level_path_aux [] as ‹intra_kind (kind a)
  have "same_level_path_aux [] (as@[a])" by(rule slpa_snoc_intra)
  from ‹intra_kind (kind a)
  have "upd_cs [] (as@[a]) = upd_cs [] as"
    by(fastforce simp:upd_cs_Append intra_kind_def)
  moreover
  from ‹same_level_path_aux [] as ‹intra_kind (kind a)
  have "same_level_path_aux [] (as@[a])" by(rule slpa_snoc_intra)
  ultimately show ?case using ‹same_level_path_aux (upd_cs [] as) cs
    ‹upd_cs (upd_cs [] as) cs = []
    by simp
next
  case (slpra_Return cs a as Q p f)
  note IH = n' n''. upd_rev_cs (a#cs) as = []; n -as→* n';
    valid_return_list (a#cs) n'
   same_level_path_aux [] as 
     same_level_path_aux (upd_cs [] as) (a#cs) 
     upd_cs (upd_cs [] as) (a#cs) = []
  from n -as@[a]→* n' have "n -as→* sourcenode a" and "valid_edge a"
    and "n' = targetnode a" by(auto intro:path_split_snoc)
  from valid_edge a kind a = Qpf have "p = get_proc (sourcenode a)"
     by(rule get_proc_return[THEN sym])
   from ‹valid_return_list cs n' n' = targetnode a
   have "valid_return_list cs (targetnode a)" by simp
   with valid_edge a kind a = Qpf p = get_proc (sourcenode a)
   have "valid_return_list (a#cs) (sourcenode a)"
     apply(clarsimp simp:valid_return_list_def)
     apply(case_tac cs') apply auto
     apply(erule_tac x="list" in allE) apply clarsimp
     by(case_tac list,auto simp:targetnodes_def)
   from ‹upd_rev_cs cs (as@[a]) = [] kind a = Qpf
   have "upd_rev_cs (a#cs) as = []" by simp
   from IH[OF this n -as→* sourcenode a ‹valid_return_list (a#cs) (sourcenode a)]
   have "same_level_path_aux [] as"
     and "same_level_path_aux (upd_cs [] as) (a#cs)"
     and "upd_cs (upd_cs [] as) (a#cs) = []" by simp_all
   show ?case 
  proof(cases "upd_cs [] as")
    case Nil
    with kind a = Qpf ‹same_level_path_aux (upd_cs [] as) (a#cs)
    have False by simp
    thus ?thesis by simp
  next
    case (Cons cx csx)
    with kind a = Qpf ‹same_level_path_aux (upd_cs [] as) (a#cs)
    obtain Qx fx 
      where match:"a  get_return_edges cx" "same_level_path_aux csx cs" by auto
    from kind a = Qpf Cons have "upd_cs [] (as@[a]) = csx"
      by(rule upd_cs_snoc_Return_Cons)
    with ‹same_level_path_aux (upd_cs [] as) (a#cs)
      kind a = Qpf match
    have "same_level_path_aux (upd_cs [] (as@[a])) cs" by simp
    from ‹upd_cs [] (as@[a]) = csx kind a = Qpf Cons
      ‹upd_cs (upd_cs [] as) (a#cs) = []
    have "upd_cs (upd_cs [] (as@[a])) cs = []" by simp
    from Cons kind a = Qpf match
    have "same_level_path_aux (upd_cs [] as) [a]" by simp
    with ‹same_level_path_aux [] as have "same_level_path_aux [] (as@[a])"
      by(rule same_level_path_aux_Append)
    with ‹same_level_path_aux (upd_cs [] (as@[a])) cs
      ‹upd_cs (upd_cs [] (as@[a])) cs = []
    show ?thesis by simp
  qed
next
  case (slpra_Call cs a as Q r p fs cx csx)
  note IH = n'. upd_rev_cs csx as = []; n -as→* n'; valid_return_list csx n'
     same_level_path_aux [] as 
       same_level_path_aux (upd_cs [] as) csx  upd_cs (upd_cs [] as) csx = []
  note match = cs = cx#csx cx  get_return_edges a
  from n -as@[a]→* n' have "n -as→* sourcenode a" and "valid_edge a"
    and "n' = targetnode a" by(auto intro:path_split_snoc)
  from valid_edge a match 
  have "get_proc (sourcenode a) = get_proc (targetnode cx)"
    by(fastforce intro:get_proc_get_return_edge)
  with ‹valid_return_list cs n' cs = cx#csx
  have "valid_return_list csx (sourcenode a)"
    apply(clarsimp simp:valid_return_list_def)
    apply(erule_tac x="cx#cs'" in allE) apply clarsimp
    by(case_tac cs',auto simp:targetnodes_def)
  from kind a = Q:rpfs match ‹upd_rev_cs cs (as@[a]) = []
  have "upd_rev_cs csx as = []" by simp
  from IH[OF this n -as→* sourcenode a ‹valid_return_list csx (sourcenode a)]
  have "same_level_path_aux [] as"
    and "same_level_path_aux (upd_cs [] as) csx" and "upd_cs (upd_cs [] as) csx = []"
    by simp_all
  from ‹same_level_path_aux [] as kind a = Q:rpfs
  have "same_level_path_aux [] (as@[a])" by(rule slpa_snoc_Call)
  from valid_edge a kind a = Q:rpfs match obtain Q' f' where "kind cx = Q'pf'"
    by(fastforce dest!:call_return_edges)
  from kind a = Q:rpfs have "upd_cs [] (as@[a]) = a#(upd_cs [] as)"
    by(rule upd_cs_snoc_Call)
  with ‹same_level_path_aux (upd_cs [] as) csx kind a = Q:rpfs 
    kind cx = Q'pf' match
  have "same_level_path_aux (upd_cs [] (as@[a])) cs" by simp
  from ‹upd_cs (upd_cs [] as) csx = [] ‹upd_cs [] (as@[a]) = a#(upd_cs [] as)
    kind a = Q:rpfs kind cx = Q'pf' match
  have "upd_cs (upd_cs [] (as@[a])) cs = []" by simp
  with ‹same_level_path_aux [] (as@[a])
    ‹same_level_path_aux (upd_cs [] (as@[a])) cs show ?case by simp
qed


subsubsection ‹Lemmas on paths with (_Entry_)›

lemma path_Entry_target [dest]:
  assumes "n -as→* (_Entry_)"
  shows "n = (_Entry_)" and "as = []"
using n -as→* (_Entry_)
proof(induct n as n'"(_Entry_)" rule:path.induct)
  case (Cons_path n'' as a n)
  from n'' = (_Entry_) targetnode a = n'' valid_edge a have False
    by -(rule Entry_target,simp_all)
  { case 1
    from ‹False› show ?case ..
  next
    case 2
    from ‹False› show ?case ..
  }
qed simp_all



lemma Entry_sourcenode_hd:
  assumes "n -as→* n'" and "(_Entry_)  set (sourcenodes as)"
  shows "n = (_Entry_)" and "(_Entry_)  set (sourcenodes (tl as))"
  using n -as→* n' (_Entry_)  set (sourcenodes as)
proof(induct rule:path.induct)
  case (empty_path n) case 1
  thus ?case by(simp add:sourcenodes_def)
next
  case (empty_path n) case 2
  thus ?case by(simp add:sourcenodes_def)
next
  case (Cons_path n'' as n' a n)
  note IH1 = (_Entry_)  set(sourcenodes as)  n'' = (_Entry_)
  note IH2 = (_Entry_)  set(sourcenodes as)  (_Entry_)  set(sourcenodes(tl as))
  have "(_Entry_)  set (sourcenodes(tl(a#as)))"
  proof(rule ccontr)
    assume "¬ (_Entry_)  set (sourcenodes (tl (a#as)))"
    hence "(_Entry_)  set (sourcenodes as)" by simp
    from IH1[OF this] have "n'' = (_Entry_)" by simp
    with targetnode a = n'' valid_edge a show False by -(erule Entry_target,simp)
  qed
  hence "(_Entry_)  set (sourcenodes(tl(a#as)))" by fastforce
  { case 1
    with (_Entry_)  set (sourcenodes(tl(a#as))) sourcenode a = n
    show ?case by(simp add:sourcenodes_def)
  next
    case 2
    with (_Entry_)  set (sourcenodes(tl(a#as))) sourcenode a = n
    show ?case by(simp add:sourcenodes_def)
  }
qed


lemma Entry_no_inner_return_path: 
  assumes "(_Entry_) -as@[a]→* n" and "a  set as. intra_kind(kind a)"
  and "kind a = Qpf"
  shows "False"
proof -
  from (_Entry_) -as@[a]→* n have "(_Entry_) -as→* sourcenode a" 
    and "valid_edge a" and "targetnode a = n" by(auto intro:path_split_snoc)
  from (_Entry_) -as→* sourcenode a a  set as. intra_kind(kind a)
  have "(_Entry_) -asι* sourcenode a" by(simp add:intra_path_def)
  hence "get_proc (sourcenode a) = Main"
    by(fastforce dest:intra_path_get_procs simp:get_proc_Entry)
  with valid_edge a kind a = Qpf have "p = Main"
    by(fastforce dest:get_proc_return)
  with valid_edge a kind a = Qpf show ?thesis
    by(fastforce intro:Main_no_return_source)
qed



lemma vpra_no_slpra:
  "valid_path_rev_aux cs as; n -as→* n'; valid_return_list cs n'; cs  [];
    xs ys. as = xs@ys  (¬ same_level_path_rev_aux cs ys  upd_rev_cs cs ys  [])
   a Q f. valid_edge a  kind a = Qget_proc nf"
proof(induct arbitrary:n' rule:vpra_induct)
  case (vpra_empty cs)
  from ‹valid_return_list cs n' cs  [] obtain Q f where "valid_edge (hd cs)"
    and "kind (hd cs) = Qget_proc n'f"
    apply(unfold valid_return_list_def)
    apply(drule hd_Cons_tl[THEN sym])
    apply(erule_tac x="[]" in allE) 
    apply(erule_tac x="hd cs" in allE)
    by auto
  from n -[]→* n' have "n = n'" by fastforce
  with valid_edge (hd cs) kind (hd cs) = Qget_proc n'f show ?case by blast
next
  case (vpra_intra cs a as)
  note IH = n'. n -as→* n'; valid_return_list cs n'; cs  [];
    xs ys. as = xs@ys  ¬ same_level_path_rev_aux cs ys  upd_rev_cs cs ys  []
     a Q f. valid_edge a  kind a = Qget_proc nf
  note all = xs ys. as@[a] = xs@ys 
     ¬ same_level_path_rev_aux cs ys  upd_rev_cs cs ys  []
  from n -as@[a]→* n' have "n -as→* sourcenode a" and "valid_edge a"
    and "targetnode a = n'" by(auto intro:path_split_snoc)
  from ‹valid_return_list cs n' cs  [] obtain Q f where "valid_edge (hd cs)"
    and "kind (hd cs) = Qget_proc n'f"
    apply(unfold valid_return_list_def)
    apply(drule hd_Cons_tl[THEN sym])
    apply(erule_tac x="[]" in allE) 
    apply(erule_tac x="hd cs" in allE)
    by auto
  from valid_edge a ‹intra_kind (kind a)
  have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
  with kind (hd cs) = Qget_proc n'f targetnode a = n'
  have "kind (hd cs) = Qget_proc (sourcenode a)f" by simp
  from ‹valid_return_list cs n' targetnode a = n'
    get_proc (sourcenode a) = get_proc (targetnode a)
  have "valid_return_list cs (sourcenode a)"
    apply(clarsimp simp:valid_return_list_def)
    apply(erule_tac x="cs'" in allE)
    apply(erule_tac x="c" in allE)
    by(auto split:list.split)
  from all ‹intra_kind (kind a)
  have "xs ys. as = xs@ys 
     ¬ same_level_path_rev_aux cs ys  upd_rev_cs cs ys  []"
    apply clarsimp apply(erule_tac x="xs" in allE)
    by(auto simp:intra_kind_def)
  from IH[OF n -as→* sourcenode a ‹valid_return_list cs (sourcenode a)
    cs  [] this] show ?case .
next
  case (vpra_Return cs a as Q p f)
  note IH = n'. n -as→* n'; valid_return_list (a#cs) n'; a#cs  [];
   xs ys. as = xs @ ys 
    ¬ same_level_path_rev_aux (a#cs) ys  upd_rev_cs (a#cs) ys  []
   a Q f. valid_edge a  kind a = Qget_proc nf
  from n -as@[a]→* n' have "n -as→* sourcenode a" and "valid_edge a"
    and "targetnode a = n'" by(auto intro:path_split_snoc)
  from valid_edge a kind a = Qpf have "get_proc (sourcenode a) = p"
    by(rule get_proc_return)
  with kind a = Qpf ‹valid_return_list cs n' valid_edge a targetnode a = n'
  have "valid_return_list (a#cs) (sourcenode a)"
    apply(clarsimp simp:valid_return_list_def)
    apply(case_tac cs') apply auto
    apply(erule_tac x="list" in allE)
    apply(erule_tac x="c" in allE)
    by(auto split:list.split simp:targetnodes_def)
  from xs ys. as@[a] = xs@ys 
    ¬ same_level_path_rev_aux cs ys  upd_rev_cs cs ys  [] kind a = Qpf
  have "xs ys. as = xs@ys 
    ¬ same_level_path_rev_aux (a#cs) ys  upd_rev_cs (a#cs) ys  []"
    apply clarsimp apply(erule_tac x="xs" in allE)
    by auto
  from IH[OF n -as→* sourcenode a ‹valid_return_list (a#cs) (sourcenode a)
    _ this] show ?case by simp
next
  case (vpra_CallEmpty cs a as Q p fs)
  from cs = [] cs  [] have False by simp
  thus ?case by simp
next
  case (vpra_CallCons cs a as Q r p fs c' cs')
  note IH = n'. n -as→* n'; valid_return_list cs' n'; cs'  [];
    xs ys. as = xs@ys 
       ¬ same_level_path_rev_aux cs' ys  upd_rev_cs cs' ys  []
     a Q f. valid_edge a  kind a = Qget_proc nf
  note all = xs ys. as@[a] = xs@ys 
     ¬ same_level_path_rev_aux cs ys  upd_rev_cs cs ys  []
  from n -as@[a]→* n' have "n -as→* sourcenode a" and "valid_edge a"
    and "targetnode a = n'" by(auto intro:path_split_snoc)
  from ‹valid_return_list cs n' cs = c'#cs' have "valid_edge c'"
    apply(clarsimp simp:valid_return_list_def)
    apply(erule_tac x="[]" in allE)
    by auto
  show ?case
  proof(cases "cs' = []")
    case True
    with cs = c'#cs' kind a = Q:rpfs c'  get_return_edges a
    have "same_level_path_rev_aux cs ([]@[a])"
      and "upd_rev_cs cs ([]@[a]) = []"
      by(simp only:same_level_path_rev_aux.simps upd_rev_cs.simps,clarsimp)+
    with all have False by(erule_tac x="as" in allE) fastforce
    thus ?thesis by simp
  next
    case False
    with ‹valid_return_list cs n' cs = c'#cs'
    have "valid_return_list cs' (targetnode c')"
      apply(clarsimp simp:valid_return_list_def)
      apply(hypsubst_thin)
      apply(erule_tac x="c'#cs'" in allE)
      apply(auto simp:targetnodes_def)
       apply(case_tac cs') apply auto
      apply(case_tac list) apply(auto simp:targetnodes_def)
      done
    from valid_edge a c'  get_return_edges a
    have "get_proc (sourcenode a) = get_proc (targetnode c')"
      by(rule get_proc_get_return_edge)
    with ‹valid_return_list cs' (targetnode c')
    have "valid_return_list cs' (sourcenode a)"
      apply(clarsimp simp:valid_return_list_def)
      apply(hypsubst_thin)
    apply(erule_tac x="cs'" in allE)
    apply(erule_tac x="c" in allE)
    by(auto split:list.split)
    from all kind a = Q:rpfs cs = c'#cs' c'  get_return_edges a
    have "xs ys. as = xs@ys 
       ¬ same_level_path_rev_aux cs' ys  upd_rev_cs cs' ys  []"
      apply clarsimp apply(erule_tac x="xs" in allE)
      by auto  
    from IH[OF n -as→* sourcenode a ‹valid_return_list cs' (sourcenode a)
      False this] show ?thesis .
  qed
qed


lemma valid_Entry_path_cases:
  assumes "(_Entry_) -as* n" and "as  []"
  shows "(a' as'. as = as'@[a']  intra_kind(kind a')) 
         (a' as' Q r p fs. as = as'@[a']  kind a' = Q:rpfs) 
         (as' as'' n'. as = as'@as''  as''  []  n' -as''sl* n)"
proof -
  from as  [] obtain a' as' where "as = as'@[a']" by(cases as rule:rev_cases) auto
  thus ?thesis
  proof(cases "kind a'" rule:edge_kind_cases)
    case Intra with as = as'@[a'] show ?thesis by simp
  next
    case Call with as = as'@[a'] show ?thesis by simp
  next
    case (Return Q p f)
    from (_Entry_) -as* n have "(_Entry_) -as→* n" and "valid_path_rev_aux [] as"
      by(auto intro:vp_to_vpra simp:vp_def valid_path_def)
    from (_Entry_) -as→* n as = as'@[a']
    have "(_Entry_) -as'→* sourcenode a'" and "valid_edge a'" 
      and "targetnode a' = n"
      by(auto intro:path_split_snoc)
    from ‹valid_path_rev_aux [] as as = as'@[a'] Return
    have "valid_path_rev_aux [a'] as'" by simp
    from valid_edge a' Return
    have "valid_return_list [a'] (sourcenode a')"
      apply(clarsimp simp:valid_return_list_def)
      apply(case_tac cs') 
      by(auto intro:get_proc_return[THEN sym])
    show ?thesis
    proof(cases "xs ys. as' = xs@ys  
        (¬ same_level_path_rev_aux [a'] ys  upd_rev_cs [a'] ys  [])")
      case True
      with ‹valid_path_rev_aux [a'] as' (_Entry_) -as'→* sourcenode a'
        ‹valid_return_list [a'] (sourcenode a')
      obtain ax Qx fx where "valid_edge ax" and "kind ax = Qxget_proc (_Entry_)fx"
        by(fastforce dest!:vpra_no_slpra)
      hence False by(fastforce intro:Main_no_return_source simp:get_proc_Entry)
      thus ?thesis by simp
    next
      case False
      then obtain xs ys where "as' = xs@ys" and "same_level_path_rev_aux [a'] ys"
        and "upd_rev_cs [a'] ys = []" by auto
      with Return have "same_level_path_rev_aux [] (ys@[a'])"
        and "upd_rev_cs [] (ys@[a']) = []" by simp_all
      from ‹upd_rev_cs [a'] ys = [] have "ys  []" by auto
      with (_Entry_) -as'→* sourcenode a' as' = xs@ys
      have "hd(sourcenodes ys) -ys→* sourcenode a'"
        by(cases ys)(auto dest:path_split_second simp:sourcenodes_def)
      with targetnode a' = n valid_edge a'
      have "hd(sourcenodes ys) -ys@[a']→* n"
        by(fastforce intro:path_Append path_edge)
      with ‹same_level_path_rev_aux [] (ys@[a']) ‹upd_rev_cs [] (ys@[a']) = []
      have "same_level_path (ys@[a'])"
        by(fastforce dest:slpra_to_slpa simp:same_level_path_def valid_return_list_def)
      with ‹hd(sourcenodes ys) -ys@[a']→* n have "hd(sourcenodes ys) -ys@[a']sl* n"
        by(simp add:slp_def)
      with as = as'@[a'] as' = xs@ys Return
      have "as' as'' n'. as = as'@as''  as''  []  n' -as''sl* n"
        by(rule_tac x="xs" in exI) auto
      thus ?thesis by simp
    qed
  qed
qed


lemma valid_Entry_path_ascending_path:
  assumes "(_Entry_) -as* n"
  obtains as' where "(_Entry_) -as'* n" 
  and "set(sourcenodes as')  set(sourcenodes as)"
  and "a'  set as'. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)"
proof(atomize_elim)
  from (_Entry_) -as* n
  show "as'. (_Entry_) -as'* n  set(sourcenodes as')  set(sourcenodes as)
              (a'  set as'. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs))"
  proof(induct as arbitrary:n rule:length_induct)
    fix as n
    assume IH:"as''. length as'' < length as 
      (n'. (_Entry_) -as''* n' 
       (as'. (_Entry_) -as'* n'  set (sourcenodes as')  set (sourcenodes as'') 
              (a'set as'. intra_kind (kind a')  (Q r p fs. kind a' = Q:rpfs))))"
      and "(_Entry_) -as* n"
    show "as'. (_Entry_) -as'* n  set(sourcenodes as')  set(sourcenodes as)
              (a'  set as'. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs))"
    proof(cases "as = []")
      case True
      with (_Entry_) -as* n show ?thesis by(fastforce simp:sourcenodes_def vp_def)
    next
      case False
      with (_Entry_) -as* n
      have "((a' as'. as = as'@[a']  intra_kind(kind a')) 
         (a' as' Q r p fs. as = as'@[a']  kind a' = Q:rpfs)) 
         (as' as'' n'. as = as'@as''  as''  []  n' -as''sl* n)"
        by(fastforce dest!:valid_Entry_path_cases)
      thus ?thesis apply -
      proof(erule disjE)+
        assume "a' as'. as = as'@[a']  intra_kind(kind a')"
        then obtain a' as' where "as = as'@[a']" and "intra_kind(kind a')" by blast
        from (_Entry_) -as* n as = as'@[a']
        have "(_Entry_) -as'* sourcenode a'" and "valid_edge a'"
          and "targetnode a' = n"
          by(auto intro:vp_split_snoc)
        from valid_edge a' ‹intra_kind(kind a')
        have "sourcenode a' -[a']sl* targetnode a'"
          by(fastforce intro:path_edge intras_same_level_path simp:slp_def)
        from IH (_Entry_) -as'* sourcenode a' as = as'@[a']
        obtain xs where "(_Entry_) -xs* sourcenode a'" 
          and "set (sourcenodes xs)  set (sourcenodes as')"
          and "a'set xs. intra_kind (kind a')  (Q r p fs. kind a' = Q:rpfs)"
          apply(erule_tac x="as'" in allE) by auto
        from (_Entry_) -xs* sourcenode a' sourcenode a' -[a']sl* targetnode a'
        have "(_Entry_) -xs@[a']* targetnode a'" by(rule vp_slp_Append)
        with targetnode a' = n have "(_Entry_) -xs@[a']* n" by simp
        moreover
        from ‹set (sourcenodes xs)  set (sourcenodes as') as = as'@[a']
        have "set (sourcenodes (xs@[a']))  set (sourcenodes as)"
          by(auto simp:sourcenodes_def)
        moreover
        from a'set xs. intra_kind (kind a')  (Q r p fs. kind a' = Q:rpfs) 
          ‹intra_kind(kind a')
        have "a'set (xs@[a']). intra_kind (kind a')  
                                 (Q r p fs. kind a' = Q:rpfs)"
          by fastforce
        ultimately show ?thesis by blast
      next
        assume "a' as' Q r p fs. as = as'@[a']  kind a' = Q:rpfs"
        then obtain a' as' Q r p fs where "as = as'@[a']" and "kind a' = Q:rpfs" 
          by blast
        from (_Entry_) -as* n as = as'@[a']
        have "(_Entry_) -as'* sourcenode a'" and "valid_edge a'"
          and "targetnode a' = n"
          by(auto intro:vp_split_snoc)
        from IH (_Entry_) -as'* sourcenode a' as = as'@[a']
        obtain xs where "(_Entry_) -xs* sourcenode a'" 
          and "set (sourcenodes xs)  set (sourcenodes as')"
          and "a'set xs. intra_kind (kind a')  (Q r p fs. kind a' = Q:rpfs)"
          apply(erule_tac x="as'" in allE) by auto
        from targetnode a' = n valid_edge a' kind a' = Q:rpfs
          (_Entry_) -xs* sourcenode a'
        have "(_Entry_) -xs@[a']* n"
          by(fastforce intro:path_Append path_edge vpa_snoc_Call 
                       simp:vp_def valid_path_def)
        moreover
        from ‹set (sourcenodes xs)  set (sourcenodes as') as = as'@[a']
        have "set (sourcenodes (xs@[a']))  set (sourcenodes as)"
          by(auto simp:sourcenodes_def)
        moreover
        from a'set xs. intra_kind (kind a')  (Q r p fs. kind a' = Q:rpfs) 
          kind a' = Q:rpfs
        have "a'set (xs@[a']). intra_kind (kind a')  
                                 (Q r p fs. kind a' = Q:rpfs)"
          by fastforce
        ultimately show ?thesis by blast
      next
        assume "as' as'' n'. as = as'@as''  as''  []  n' -as''sl* n"
        then obtain as' as'' n' where "as = as'@as''" and "as''  []"
          and "n' -as''sl* n" by blast
        from (_Entry_) -as* n as = as'@as'' as''  []
        have "(_Entry_) -as'* hd(sourcenodes as'')"
          by(cases as'',auto intro:vp_split simp:sourcenodes_def)
        from n' -as''sl* n as''  [] have "hd(sourcenodes as'') = n'"
          by(fastforce intro:path_sourcenode simp:slp_def)
        from as = as'@as'' as''  [] have "length as' < length as" by simp
        with IH (_Entry_) -as'* hd(sourcenodes as'')
          ‹hd(sourcenodes as'') = n'
        obtain xs where "(_Entry_) -xs* n'" 
          and "set (sourcenodes xs)  set (sourcenodes as')"
          and "a'set xs. intra_kind (kind a')  (Q r p fs. kind a' = Q:rpfs)"
          apply(erule_tac x="as'" in allE) by auto
        from n' -as''sl* n obtain ys where "n' -ysι* n"
          and "set(sourcenodes ys)  set(sourcenodes as'')"
          by(erule same_level_path_inner_path)
        from (_Entry_) -xs* n' n' -ysι* n have "(_Entry_) -xs@ys* n"
          by(fastforce intro:vp_slp_Append intra_path_slp)
        moreover
        from ‹set (sourcenodes xs)  set (sourcenodes as')
          ‹set(sourcenodes ys)  set(sourcenodes as'') as = as'@as''
        have "set (sourcenodes (xs@ys))  set(sourcenodes as)"
          by(auto simp:sourcenodes_def)
        moreover
        from a'set xs. intra_kind (kind a')  (Q r p fs. kind a' = Q:rpfs)
          n' -ysι* n
        have "a'set (xs@ys). intra_kind (kind a')  (Q r p fs. kind a' = Q:rpfs)"
          by(fastforce simp:intra_path_def)
        ultimately show ?thesis by blast
      qed
    qed
  qed
qed



end

end

Theory CFGExit

theory CFGExit imports CFG begin

subsection ‹Adds an exit node to the abstract CFG›

locale CFGExit = CFG sourcenode targetnode kind valid_edge Entry 
    get_proc get_return_edges procs Main
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  ('var,'val,'ret,'pname) edge_kind" 
  and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')")  and get_proc :: "'node  'pname"
  and get_return_edges :: "'edge  'edge set"
  and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname" +
  fixes Exit::"'node"  ("'('_Exit'_')")
  assumes Exit_source [dest]: "valid_edge a; sourcenode a = (_Exit_)  False"
  and get_proc_Exit:"get_proc (_Exit_) = Main"
  and Exit_no_return_target:
    "valid_edge a; kind a = Qpf; targetnode a = (_Exit_)  False"
  and Entry_Exit_edge: "a. valid_edge a  sourcenode a = (_Entry_) 
    targetnode a = (_Exit_)  kind a = (λs. False)"
  

begin

lemma Entry_noteq_Exit [dest]:
  assumes eq:"(_Entry_) = (_Exit_)" shows "False"
proof -
  from Entry_Exit_edge obtain a where "sourcenode a = (_Entry_)" 
    and "valid_edge a" by blast
  with eq show False by simp(erule Exit_source)
qed

lemma Exit_noteq_Entry [dest]:"(_Exit_) = (_Entry_)  False"
  by(rule Entry_noteq_Exit[OF sym],simp)


lemma [simp]: "valid_node (_Entry_)"
proof -
  from Entry_Exit_edge obtain a where "sourcenode a = (_Entry_)" 
    and "valid_edge a" by blast
  thus ?thesis by(fastforce simp:valid_node_def)
qed

lemma [simp]: "valid_node (_Exit_)"
proof -
  from Entry_Exit_edge obtain a where "targetnode a = (_Exit_)"
    and "valid_edge a" by blast
  thus ?thesis by(fastforce simp:valid_node_def)
qed


subsubsection ‹Definition of method_exit›

definition method_exit :: "'node  bool"
  where "method_exit n  n = (_Exit_)  
  (a Q p f. n = sourcenode a  valid_edge a  kind a = Qpf)"


lemma method_exit_cases:
  "method_exit n; n = (_Exit_)  P;
    a Q f p. n = sourcenode a; valid_edge a; kind a = Qpf  P  P"
by(fastforce simp:method_exit_def)


lemma method_exit_inner_path:
  assumes "method_exit n" and "n -asι* n'" shows "as = []"
  using ‹method_exit n
proof(rule method_exit_cases)
  assume "n = (_Exit_)"
  show ?thesis
  proof(cases as)
    case (Cons a' as')
    with n -asι* n' have "n = sourcenode a'" and "valid_edge a'"
      by(auto elim:path_split_Cons simp:intra_path_def)
    with n = (_Exit_) have "sourcenode a' = (_Exit_)" by simp
    with valid_edge a' have False by(rule Exit_source)
    thus ?thesis by simp
  qed simp
next
  fix a Q f p
  assume "n = sourcenode a" and "valid_edge a" and "kind a = Qpf"
  show ?thesis
  proof(cases as)
    case (Cons a' as')
    with n -asι* n' have "n = sourcenode a'" and "valid_edge a'" 
      and "intra_kind (kind a')"
      by(auto elim:path_split_Cons simp:intra_path_def)
    from valid_edge a kind a = Qpf valid_edge a' n = sourcenode a 
      n = sourcenode a' ‹intra_kind (kind a')
    have False by(fastforce dest:return_edges_only simp:intra_kind_def)
    thus ?thesis by simp
  qed simp
qed


subsubsection ‹Definition of inner_node›

definition inner_node :: "'node  bool"
  where inner_node_def: 
  "inner_node n  valid_node n  n  (_Entry_)  n  (_Exit_)"


lemma inner_is_valid:
  "inner_node n  valid_node n"
by(simp add:inner_node_def valid_node_def)

lemma [dest]:
  "inner_node (_Entry_)  False"
by(simp add:inner_node_def)

lemma [dest]:
  "inner_node (_Exit_)  False" 
by(simp add:inner_node_def)

lemma [simp]:"valid_edge a; targetnode a  (_Exit_) 
   inner_node (targetnode a)"
  by(simp add:inner_node_def,rule ccontr,simp,erule Entry_target)

lemma [simp]:"valid_edge a; sourcenode a  (_Entry_)
   inner_node (sourcenode a)"
  by(simp add:inner_node_def,rule ccontr,simp,erule Exit_source)

lemma valid_node_cases [consumes 1, case_names "Entry" "Exit" "inner"]:
  "valid_node n; n = (_Entry_)  Q; n = (_Exit_)  Q;
    inner_node n  Q  Q"
apply(auto simp:valid_node_def)
 apply(case_tac "sourcenode a = (_Entry_)") apply auto
apply(case_tac "targetnode a = (_Exit_)") apply auto
done


subsubsection ‹Lemmas on paths with (_Exit_)›

lemma path_Exit_source:
  "n -as→* n'; n = (_Exit_)  n' = (_Exit_)  as = []"
proof(induct rule:path.induct)
  case (Cons_path n'' as n' a n)
  from n = (_Exit_) sourcenode a = n valid_edge a have False 
    by -(rule Exit_source,simp_all)
  thus ?case by simp
qed simp

lemma [dest]:"(_Exit_) -as→* n'  n' = (_Exit_)  as = []"
  by(fastforce elim!:path_Exit_source)

lemma Exit_no_sourcenode[dest]:
  assumes isin:"(_Exit_)  set (sourcenodes as)" and path:"n -as→* n'"
  shows False
proof -
  from isin obtain ns' ns'' where "sourcenodes as = ns'@(_Exit_)#ns''"
    by(auto dest:split_list simp:sourcenodes_def)
  then obtain as' as'' a where "as = as'@a#as''"
    and source:"sourcenode a = (_Exit_)"
    by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
  with path have "valid_edge a" by(fastforce dest:path_split)
  with source show ?thesis by -(erule Exit_source)
qed



lemma vpa_no_slpa:
  "valid_path_aux cs as; n -as→* n'; valid_call_list cs n; cs  [];
    xs ys. as = xs@ys  (¬ same_level_path_aux cs xs  upd_cs cs xs  [])
   a Q r fs. valid_edge a  kind a = Q:rget_proc n'fs"
proof(induct arbitrary:n rule:vpa_induct)
  case (vpa_empty cs)
  from ‹valid_call_list cs n cs  [] obtain Q r fs where "valid_edge (hd cs)"
    and "kind (hd cs) = Q:rget_proc nfs"
    apply(unfold valid_call_list_def)
    apply(drule hd_Cons_tl[THEN sym])
    apply(erule_tac x="[]" in allE) 
    apply(erule_tac x="hd cs" in allE)
    by auto
  from n -[]→* n' have "n = n'" by fastforce
  with valid_edge (hd cs) kind (hd cs) = Q:rget_proc nfs show ?case by blast
next
  case (vpa_intra cs a as)
  note IH = n. n -as→* n'; valid_call_list cs n; cs  [];
    xs ys. as = xs@ys  ¬ same_level_path_aux cs xs  upd_cs cs xs  []
     a' Q' r' fs'. valid_edge a'  kind a' = Q':r'get_proc n'fs'
  note all = xs ys. a#as = xs@ys 
     ¬ same_level_path_aux cs xs  upd_cs cs xs  []
  from n -a#as→* n' have "sourcenode a = n" and "valid_edge a" 
    and "targetnode a -as→* n'"
    by(auto intro:path_split_Cons)
  from ‹valid_call_list cs n cs  [] obtain Q r fs where "valid_edge (hd cs)"
    and "kind (hd cs) = Q:rget_proc nfs"
    apply(unfold valid_call_list_def)
    apply(drule hd_Cons_tl[THEN sym])
    apply(erule_tac x="[]" in allE) 
    apply(erule_tac x="hd cs" in allE)
    by auto
  from valid_edge a ‹intra_kind (kind a)
  have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
  with kind (hd cs) = Q:rget_proc nfs sourcenode a = n
  have "kind (hd cs) = Q:rget_proc (targetnode a)fs" by simp
  from ‹valid_call_list cs n sourcenode a = n
    get_proc (sourcenode a) = get_proc (targetnode a)
  have "valid_call_list cs (targetnode a)"
    apply(clarsimp simp:valid_call_list_def)
    apply(erule_tac x="cs'" in allE)
    apply(erule_tac x="c" in allE)
    by(auto split:list.split)
  from all ‹intra_kind (kind a)
  have "xs ys. as = xs@ys  ¬ same_level_path_aux cs xs  upd_cs cs xs  []"
    apply clarsimp apply(erule_tac x="a#xs" in allE)
    by(auto simp:intra_kind_def)
  from IH[OF targetnode a -as→* n' ‹valid_call_list cs (targetnode a)
    cs  [] this] show ?case .
next
  case (vpa_Call cs a as Q r p fs)
  note IH = n. n -as→* n'; valid_call_list (a#cs) n; a#cs  [];
    xs ys. as = xs@ys  ¬ same_level_path_aux (a#cs) xs  upd_cs (a#cs) xs  []
     a' Q' r' fs'. valid_edge a'  kind a' = Q':r'get_proc n'fs'
  note all = xs ys.
    a#as = xs@ys  ¬ same_level_path_aux cs xs  upd_cs cs xs  []
  from n -a#as→* n' have "sourcenode a = n" and "valid_edge a" 
    and "targetnode a -as→* n'"
    by(auto intro:path_split_Cons)
  from valid_edge a kind a = Q:rpfs have "get_proc (targetnode a) = p"
    by(rule get_proc_call)
  with kind a = Q:rpfs have "kind a = Q:rget_proc (targetnode a)fs" by simp
  with ‹valid_call_list cs n valid_edge a sourcenode a = n
  have "valid_call_list (a#cs) (targetnode a)"
    apply(clarsimp simp:valid_call_list_def)
    apply(case_tac cs') apply auto
    apply(erule_tac x="list" in allE)
    apply(erule_tac x="c" in allE)
    by(auto split:list.split simp:sourcenodes_def)
  from all kind a = Q:rpfs
  have "xs ys. as = xs@ys 
     ¬ same_level_path_aux (a#cs) xs  upd_cs (a#cs) xs  []"
    apply clarsimp apply(erule_tac x="a#xs" in allE)
    by auto
  from IH[OF targetnode a -as→* n' ‹valid_call_list (a#cs) (targetnode a)
    _ this] show ?case by simp
next
  case (vpa_ReturnEmpty cs a as Q p fx)
  from cs  [] cs = [] have False by simp
  thus ?case by simp
next
  case (vpa_ReturnCons cs a as Q p f c' cs')
  note IH = n. n -as→* n'; valid_call_list cs' n; cs'  [];
    xs ys. as = xs@ys  ¬ same_level_path_aux cs' xs  upd_cs cs' xs  []
     a' Q' r' fs'. valid_edge a'  kind a' = Q':r'get_proc n'fs'
  note all = xs ys. a#as = xs@ys 
     ¬ same_level_path_aux cs xs  upd_cs cs xs  []
  from n -a#as→* n' have "sourcenode a = n" and "valid_edge a" 
    and "targetnode a -as→* n'"
    by(auto intro:path_split_Cons)
  from ‹valid_call_list cs n cs = c'#cs' have "valid_edge c'"
    apply(clarsimp simp:valid_call_list_def)
    apply(erule_tac x="[]" in allE)
    by auto
  show ?case
  proof(cases "cs' = []")
    case True
    with all cs = c'#cs' kind a = Qpf a  get_return_edges c' have False
      by(erule_tac x="[a]" in allE,fastforce)
    thus ?thesis by simp
  next
    case False
    with ‹valid_call_list cs n cs = c'#cs'
    have "valid_call_list cs' (sourcenode c')"
      apply(clarsimp simp:valid_call_list_def)
      apply(hypsubst_thin)
      apply(erule_tac x="c'#cs'" in allE)
      apply(auto simp:sourcenodes_def)
       apply(case_tac cs') apply auto
      apply(case_tac list) apply(auto simp:sourcenodes_def)
      done
    from valid_edge c' a  get_return_edges c'
    have "get_proc (sourcenode c') = get_proc (targetnode a)"
      by(rule get_proc_get_return_edge)
    with ‹valid_call_list cs' (sourcenode c')
    have "valid_call_list cs' (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(hypsubst_thin)
    apply(erule_tac x="cs'" in allE)
    apply(erule_tac x="c" in allE)
    by(auto split:list.split)
    from all kind a = Qpf cs = c'#cs' a  get_return_edges c'
    have "xs ys. as = xs@ys  ¬ same_level_path_aux cs' xs  upd_cs cs' xs  []"
      apply clarsimp apply(erule_tac x="a#xs" in allE)
      by auto  
    from IH[OF targetnode a -as→* n' ‹valid_call_list cs' (targetnode a)
      False this] show ?thesis .
  qed
qed


lemma valid_Exit_path_cases:
  assumes "n -as* (_Exit_)" and "as  []"
  shows "(a' as'. as = a'#as'  intra_kind(kind a')) 
         (a' as' Q p f. as = a'#as'  kind a' = Qpf) 
         (as' as'' n'. as = as'@as''  as'  []  n -as'sl* n')"
proof -
  from as  [] obtain a' as' where "as = a'#as'" by(cases as) auto
  thus ?thesis
  proof(cases "kind a'" rule:edge_kind_cases)
    case Intra with as = a'#as' show ?thesis by simp
  next
    case Return with as = a'#as' show ?thesis by simp
  next
    case (Call Q r p f)
    from n -as* (_Exit_) have "n -as→* (_Exit_)" and "valid_path_aux [] as"
      by(simp_all add:vp_def valid_path_def)
    from n -as→* (_Exit_) as = a'#as'
    have "sourcenode a' = n" and "valid_edge a'" and "targetnode a' -as'→* (_Exit_)"
      by(auto intro:path_split_Cons)
    from ‹valid_path_aux [] as as = a'#as' Call
    have "valid_path_aux [a'] as'" by simp
    from valid_edge a' Call
    have "valid_call_list [a'] (targetnode a')"
      apply(clarsimp simp:valid_call_list_def)
      apply(case_tac cs') 
      by(auto intro:get_proc_call[THEN sym])
    show ?thesis
    proof(cases "xs ys. as' = xs@ys  
        (¬ same_level_path_aux [a'] xs  upd_cs [a'] xs  [])")
      case True
      with ‹valid_path_aux [a'] as' targetnode a' -as'→* (_Exit_)
        ‹valid_call_list [a'] (targetnode a')
      obtain ax Qx rx fsx where "valid_edge ax" and "kind ax = Qx:rxget_proc (_Exit_)fsx"
        by(fastforce dest!:vpa_no_slpa)
      hence False by(fastforce intro:Main_no_call_target simp:get_proc_Exit)
      thus ?thesis by simp
    next
      case False
      then obtain xs ys where "as' = xs@ys" and "same_level_path_aux [a'] xs"
        and "upd_cs [a'] xs = []" by auto
      with Call have "same_level_path (a'#xs)" by(simp add:same_level_path_def)
      from ‹upd_cs [a'] xs = [] have "xs  []" by auto
      with targetnode a' -as'→* (_Exit_) as' = xs@ys
      have "targetnode a' -xs→* last(targetnodes xs)"
        apply(cases xs rule:rev_cases)
        by(auto intro:path_Append path_split path_edge simp:targetnodes_def)
      with sourcenode a' = n valid_edge a' ‹same_level_path (a'#xs)
      have "n -a'#xssl* last(targetnodes xs)"
        by(fastforce intro:Cons_path simp:slp_def)
      with as = a'#as' as' = xs@ys Call 
      have "as' as'' n'. as = as'@as''  as'  []  n -as'sl* n'"
        by(rule_tac x="a'#xs" in exI) auto
      thus ?thesis by simp
    qed
  qed
qed


lemma valid_Exit_path_descending_path:
  assumes "n -as* (_Exit_)"
  obtains as' where "n -as'* (_Exit_)" 
  and "set(sourcenodes as')  set(sourcenodes as)"
  and "a'  set as'. intra_kind(kind a')  (Q f p. kind a' = Qpf)"
proof(atomize_elim)
  from n -as* (_Exit_)
  show "as'. n -as'* (_Exit_)  set(sourcenodes as')  set(sourcenodes as)
              (a'  set as'. intra_kind(kind a')  (Q f p. kind a' = Qpf))"
  proof(induct as arbitrary:n rule:length_induct)
    fix as n
    assume IH:"as''. length as'' < length as 
      (n'. n' -as''* (_Exit_) 
       (as'. n' -as'* (_Exit_)  set (sourcenodes as')  set (sourcenodes as'') 
              (a'set as'. intra_kind (kind a')  (Q f p. kind a' = Qpf))))"
      and "n -as* (_Exit_)"
    show "as'. n -as'* (_Exit_)  set(sourcenodes as')  set(sourcenodes as)
              (a'  set as'. intra_kind(kind a')  (Q f p. kind a' = Qpf))"
    proof(cases "as = []")
      case True
      with n -as* (_Exit_) show ?thesis by(fastforce simp:sourcenodes_def vp_def)
    next
      case False
      with n -as* (_Exit_)
      have "((a' as'. as = a'#as'  intra_kind(kind a')) 
         (a' as' Q p f. as = a'#as'  kind a' = Qpf)) 
         (as' as'' n'. as = as'@as''  as'  []  n -as'sl* n')"
        by(auto dest!:valid_Exit_path_cases)
      thus ?thesis apply -
      proof(erule disjE)+
        assume "a' as'. as = a'#as'  intra_kind(kind a')"
        then obtain a' as' where "as = a'#as'" and "intra_kind(kind a')" by blast
        from n -as* (_Exit_) as = a'#as'
        have "sourcenode a' = n" and "valid_edge a'" 
          and "targetnode a' -as'* (_Exit_)"
          by(auto intro:vp_split_Cons)
        from valid_edge a' ‹intra_kind(kind a')
        have "sourcenode a' -[a']sl* targetnode a'"
          by(fastforce intro:path_edge intras_same_level_path simp:slp_def)
        from IH targetnode a' -as'* (_Exit_) as = a'#as'
        obtain xs where "targetnode a' -xs* (_Exit_)" 
          and "set (sourcenodes xs)  set (sourcenodes as')"
          and "a'set xs. intra_kind (kind a')  (Q f p. kind a' = Qpf)"
          apply(erule_tac x="as'" in allE) by auto
        from sourcenode a' -[a']sl* targetnode a' targetnode a' -xs* (_Exit_)
        have "sourcenode a' -[a']@xs* (_Exit_)" by(rule slp_vp_Append)
        with sourcenode a' = n have "n -a'#xs* (_Exit_)" by simp
        moreover
        from ‹set (sourcenodes xs)  set (sourcenodes as') as = a'#as'
        have "set (sourcenodes (a'#xs))  set (sourcenodes as)"
          by(auto simp:sourcenodes_def)
        moreover
        from a'set xs. intra_kind (kind a')  (Q f p. kind a' = Qpf) 
          ‹intra_kind(kind a')
        have "a'set (a'#xs). intra_kind (kind a')  (Q f p. kind a' = Qpf)"
          by fastforce
        ultimately show ?thesis by blast
      next
        assume "a' as' Q p f. as = a'#as'  kind a' = Qpf"
        then obtain a' as' Q p f where "as = a'#as'" and "kind a' = Qpf" by blast
        from n -as* (_Exit_) as = a'#as'
        have "sourcenode a' = n" and "valid_edge a'" 
          and "targetnode a' -as'* (_Exit_)"
          by(auto intro:vp_split_Cons)
        from IH targetnode a' -as'* (_Exit_) as = a'#as'
        obtain xs where "targetnode a' -xs* (_Exit_)" 
          and "set (sourcenodes xs)  set (sourcenodes as')"
          and "a'set xs. intra_kind (kind a')  (Q f p. kind a' = Qpf)"
          apply(erule_tac x="as'" in allE) by auto
        from sourcenode a' = n valid_edge a' kind a' = Qpf
          targetnode a' -xs* (_Exit_)
        have "n -a'#xs* (_Exit_)"
          by(fastforce intro:Cons_path simp:vp_def valid_path_def)
        moreover
        from ‹set (sourcenodes xs)  set (sourcenodes as') as = a'#as'
        have "set (sourcenodes (a'#xs))  set (sourcenodes as)"
          by(auto simp:sourcenodes_def)
        moreover
        from a'set xs. intra_kind (kind a')  (Q f p. kind a' = Qpf) 
          kind a' = Qpf
        have "a'set (a'#xs). intra_kind (kind a')  (Q f p. kind a' = Qpf)"
          by fastforce
        ultimately show ?thesis by blast
      next
        assume "as' as'' n'. as = as'@as''  as'  []  n -as'sl* n'"
        then obtain as' as'' n' where "as = as'@as''" and "as'  []"
          and "n -as'sl* n'" by blast
        from n -as* (_Exit_) as = as'@as'' as'  []
        have "last(targetnodes as') -as''* (_Exit_)"
          by(cases as' rule:rev_cases,auto intro:vp_split simp:targetnodes_def)
        from n -as'sl* n' as'  [] have "last(targetnodes as') = n'"
          by(fastforce intro:path_targetnode simp:slp_def)
        from as = as'@as'' as'  [] have "length as'' < length as" by simp
        with IH ‹last(targetnodes as') -as''* (_Exit_)
          ‹last(targetnodes as') = n'
        obtain xs where "n' -xs* (_Exit_)" 
          and "set (sourcenodes xs)  set (sourcenodes as'')"
          and "a'set xs. intra_kind (kind a')  (Q f p. kind a' = Qpf)"
          apply(erule_tac x="as''" in allE) by auto
        from n -as'sl* n' obtain ys where "n -ysι* n'"
          and "set(sourcenodes ys)  set(sourcenodes as')"
          by(erule same_level_path_inner_path)
        from n -ysι* n' n' -xs* (_Exit_) have "n -ys@xs* (_Exit_)"
          by(fastforce intro:slp_vp_Append intra_path_slp)
        moreover
        from ‹set (sourcenodes xs)  set (sourcenodes as'')
          ‹set(sourcenodes ys)  set(sourcenodes as') as = as'@as''
        have "set (sourcenodes (ys@xs))  set(sourcenodes as)"
          by(auto simp:sourcenodes_def)
        moreover
        from a'set xs. intra_kind (kind a')  (Q f p. kind a' = Qpf)
          n -ysι* n'
        have "a'set (ys@xs). intra_kind (kind a')  (Q f p. kind a' = Qpf)"
          by(fastforce simp:intra_path_def)
        ultimately show ?thesis by blast
      qed
    qed
  qed
qed


lemma valid_Exit_path_intra_path:
  assumes "n -as* (_Exit_)" 
  obtains as' pex where "n -as'ι* pex" and "method_exit pex" 
  and "set(sourcenodes as')  set(sourcenodes as)"
proof(atomize_elim)
  from n -as* (_Exit_)
  obtain as' where "n -as'* (_Exit_)" 
    and "set(sourcenodes as')  set(sourcenodes as)"
    and all:"a'  set as'. intra_kind(kind a')  (Q f p. kind a' = Qpf)"
    by(erule valid_Exit_path_descending_path)
  show "as' pex. n -as'ι* pex  method_exit pex  
                  set(sourcenodes as')  set(sourcenodes as)"
  proof(cases "a'  set as'. Q f p. kind a' = Qpf")
    case True
    then obtain asx ax asx' where [simp]:"as' = asx@ax#asx'" 
      and "Q f p. kind ax = Qpf" and "a'  set asx. ¬ (Q f p. kind a' = Qpf)"
      by(erule split_list_first_propE)
    with all have "a'  set asx. intra_kind(kind a')" by auto
    from n -as'* (_Exit_) have "n -asx→* sourcenode ax"
      and "valid_edge ax" by(auto elim:path_split simp:vp_def)
    from n -asx→* sourcenode ax a'  set asx. intra_kind(kind a')
    have "n -asxι* sourcenode ax" by(simp add:intra_path_def)
    moreover
    from valid_edge ax Q f p. kind ax = Qpf
    have "method_exit (sourcenode ax)" by(fastforce simp:method_exit_def)
    moreover
    from ‹set(sourcenodes as')  set(sourcenodes as)
    have "set(sourcenodes asx)  set(sourcenodes as)" by(simp add:sourcenodes_def)
    ultimately show ?thesis by blast
  next
    case False
    with all n -as'* (_Exit_) have "n -as'ι* (_Exit_)" 
      by(fastforce simp:vp_def intra_path_def)
    moreover have "method_exit (_Exit_)" by(simp add:method_exit_def)
    ultimately show ?thesis using ‹set(sourcenodes as')  set(sourcenodes as)
      by blast
  qed
qed



end 

end

Theory CFG_wf

section ‹CFG well-formedness›

theory CFG_wf imports CFG begin

locale CFG_wf = CFG sourcenode targetnode kind valid_edge Entry 
    get_proc get_return_edges procs Main
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  ('var,'val,'ret,'pname) edge_kind" 
  and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')")  and get_proc :: "'node  'pname"
  and get_return_edges :: "'edge  'edge set"
  and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname" +
  fixes Def::"'node  'var set"
  fixes Use::"'node  'var set"
  fixes ParamDefs::"'node  'var list"
  fixes ParamUses::"'node  'var set list"
  assumes Entry_empty:"Def (_Entry_) = {}  Use (_Entry_) = {}"
  and ParamUses_call_source_length:
    "valid_edge a; kind a = Q:rpfs; (p,ins,outs)  set procs
     length(ParamUses (sourcenode a)) = length ins"
  and distinct_ParamDefs:"valid_edge a  distinct (ParamDefs (targetnode a))"
  and ParamDefs_return_target_length:
    "valid_edge a; kind a = Q'pf'; (p,ins,outs)  set procs
     length(ParamDefs (targetnode a)) = length outs"
  and ParamDefs_in_Def:
    "valid_node n; V  set (ParamDefs n)  V  Def n"
  and ins_in_Def:
    "valid_edge a; kind a = Q:rpfs; (p,ins,outs)  set procs; V  set ins
     V  Def (targetnode a)"
  and call_source_Def_empty:
    "valid_edge a; kind a = Q:rpfs  Def (sourcenode a) = {}"
  and ParamUses_in_Use:
    "valid_node n; V  Union (set (ParamUses n))  V  Use n"
  and outs_in_Use:
    "valid_edge a; kind a = Qpf; (p,ins,outs)  set procs; V  set outs 
     V  Use (sourcenode a)"
  and CFG_intra_edge_no_Def_equal:
    "valid_edge a; V  Def (sourcenode a); intra_kind (kind a); pred (kind a) s
     state_val (transfer (kind a) s) V = state_val s V"
  and CFG_intra_edge_transfer_uses_only_Use:
    "valid_edge a; V  Use (sourcenode a). state_val s V = state_val s' V;
      intra_kind (kind a); pred (kind a) s; pred (kind a) s'
     V  Def (sourcenode a). state_val (transfer (kind a) s) V =
                                state_val (transfer (kind a) s') V"
  and CFG_edge_Uses_pred_equal:
    "valid_edge a; pred (kind a) s; snd (hd s) = snd (hd s');
      V  Use (sourcenode a). state_val s V = state_val s' V; length s = length s'
     pred (kind a) s'"
  and CFG_call_edge_length:
    "valid_edge a; kind a = Q:rpfs; (p,ins,outs)  set procs
     length fs = length ins"
  and CFG_call_determ:
    "valid_edge a; kind a = Q:rpfs; valid_edge a'; kind a' = Q':r'p'fs';
      sourcenode a = sourcenode a'; pred (kind a) s; pred (kind a') s
     a = a'"
  and CFG_call_edge_params:
    "valid_edge a; kind a = Q:rpfs; i < length ins; 
      (p,ins,outs)  set procs; pred (kind a) s; pred (kind a) s';
      V  (ParamUses (sourcenode a))!i. state_val s V = state_val s' V
     (params fs (fst (hd s)))!i = (params fs (fst (hd s')))!i"  
  and CFG_return_edge_fun:
    "valid_edge a; kind a = Q'pf'; (p,ins,outs)  set procs
      f' vmap vmap' = vmap'(ParamDefs (targetnode a) [:=] map vmap outs)"
  and deterministic:"valid_edge a; valid_edge a'; sourcenode a = sourcenode a';
    targetnode a  targetnode a'; intra_kind (kind a); intra_kind (kind a') 
     Q Q'. kind a = (Q)  kind a' = (Q')  
             (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))"

begin


lemma CFG_equal_Use_equal_call:
  assumes "valid_edge a" and "kind a = Q:rpfs" and "valid_edge a'"
  and "kind a' = Q':r'p'fs'" and "sourcenode a = sourcenode a'"
  and "pred (kind a) s" and "pred (kind a') s'" 
  and "snd (hd s) = snd (hd s')" and "length s = length s'"
  and "V  Use (sourcenode a). state_val s V = state_val s' V"
  shows "a = a'"
proof -
  from valid_edge a ‹pred (kind a) s ‹snd (hd s) = snd (hd s')
    V  Use (sourcenode a). state_val s V = state_val s' V ‹length s = length s'
  have "pred (kind a) s'" by(rule CFG_edge_Uses_pred_equal)
  with valid_edge a kind a = Q:rpfs valid_edge a' kind a' = Q':r'p'fs'
    sourcenode a = sourcenode a' ‹pred (kind a') s'
  show ?thesis by -(rule CFG_call_determ)
qed


lemma CFG_call_edge_param_in:
  assumes "valid_edge a" and "kind a = Q:rpfs" and "i < length ins"
  and "(p,ins,outs)  set procs" and "pred (kind a) s" and "pred (kind a) s'"
  and "V  (ParamUses (sourcenode a))!i. state_val s V = state_val s' V"
  shows "state_val (transfer (kind a) s) (ins!i) = 
         state_val (transfer (kind a) s') (ins!i)"
proof -
  from assms have params:"(params fs (fst (hd s)))!i = (params fs (fst (hd s')))!i"
    by(rule CFG_call_edge_params)
  from valid_edge a kind a = Q:rpfs (p,ins,outs)  set procs
  have [simp]:"(THE ins. outs. (p,ins,outs)  set procs) = ins"
    by(rule formal_in_THE)
  from ‹pred (kind a) s obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
  from ‹pred (kind a) s' obtain cf' cfs' where [simp]:"s' = cf'#cfs'"
    by(cases s') auto
  from kind a = Q:rpfs
  have eqs:"fst (hd (transfer (kind a) s)) = (Map.empty(ins [:=] params fs (fst cf)))"
    "fst (hd (transfer (kind a) s')) = (Map.empty(ins [:=] params fs (fst cf')))"
    by simp_all
  from valid_edge a kind a = Q:rpfs (p,ins,outs)  set procs
  have "length fs = length ins" by(rule CFG_call_edge_length)
  from (p,ins,outs)  set procs have "distinct ins" by(rule distinct_formal_ins)
  with i < length ins ‹length fs = length ins
  have "(Map.empty(ins [:=] params fs (fst cf))) (ins!i) = (params fs (fst cf))!i"
    "(Map.empty(ins [:=] params fs (fst cf'))) (ins!i) = (params fs (fst cf'))!i"
    by(fastforce intro:fun_upds_nth)+
  with eqs kind a = Q:rpfs params
  show ?thesis by simp
qed


lemma CFG_call_edge_no_param:
  assumes "valid_edge a" and "kind a = Q:rpfs" and "V  set ins"
  and "(p,ins,outs)  set procs" and "pred (kind a) s"
  shows "state_val (transfer (kind a) s) V = None"
proof -
  from valid_edge a kind a = Q:rpfs (p,ins,outs)  set procs
  have [simp]:"(THE ins. outs. (p,ins,outs)  set procs) = ins"
    by(rule formal_in_THE)
  from ‹pred (kind a) s obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
  from V  set ins have "(Map.empty(ins [:=] params fs (fst cf))) V = None"
    by(auto dest:fun_upds_notin)
  with kind a = Q:rpfs show ?thesis by simp
qed



lemma CFG_return_edge_param_out:
  assumes "valid_edge a" and "kind a = Qpf" and "i < length outs"
  and "(p,ins,outs)  set procs" and "state_val s (outs!i) = state_val s' (outs!i)"
  and "s = cf#cfx#cfs" and "s' = cf'#cfx'#cfs'"
  shows "state_val (transfer (kind a) s) ((ParamDefs (targetnode a))!i) =
         state_val (transfer (kind a) s') ((ParamDefs (targetnode a))!i)"
proof -
  from valid_edge a kind a = Qpf (p,ins,outs)  set procs
  have [simp]:"(THE outs. ins. (p,ins,outs)  set procs) = outs"
    by(rule formal_out_THE)
  from valid_edge a kind a = Qpf (p,ins,outs)  set procs s = cf#cfx#cfs
  have transfer:"fst (hd (transfer (kind a) s)) = 
    (fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf) outs)"
    by(fastforce intro:CFG_return_edge_fun)
  from valid_edge a kind a = Qpf (p,ins,outs)  set procs s' = cf'#cfx'#cfs'
  have transfer':"fst (hd (transfer (kind a) s')) = 
    (fst cfx')(ParamDefs (targetnode a) [:=] map (fst cf') outs)"
    by(fastforce intro:CFG_return_edge_fun)
  from ‹state_val s (outs!i) = state_val s' (outs!i) i < length outs
    s = cf#cfx#cfs s' = cf'#cfx'#cfs'
  have "(fst cf) (outs!i) = (fst cf') (outs!i)" by simp
  from valid_edge a have "distinct (ParamDefs (targetnode a))"
    by(fastforce intro:distinct_ParamDefs)
  from valid_edge a kind a = Qpf (p,ins,outs)  set procs
  have "length(ParamDefs (targetnode a)) = length outs"
    by(fastforce intro:ParamDefs_return_target_length)
  with i < length outs ‹distinct (ParamDefs (targetnode a))
  have "(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf) outs)
    ((ParamDefs (targetnode a))!i) = (map (fst cf) outs)!i" 
    and "(fst cfx')(ParamDefs (targetnode a) [:=] map (fst cf') outs)
             ((ParamDefs (targetnode a))!i) = (map (fst cf') outs)!i"
    by(fastforce intro:fun_upds_nth)+
  with transfer transfer' (fst cf) (outs!i) = (fst cf') (outs!i) i < length outs
  show ?thesis by simp
qed


lemma CFG_slp_no_Def_equal:
  assumes "n -assl* n'" and "valid_edge a" and "a'  get_return_edges a"
  and "V  set (ParamDefs (targetnode a'))" and "preds (kinds (a#as@[a'])) s"
  shows "state_val (transfers (kinds (a#as@[a'])) s) V = state_val s V"
proof -
  from valid_edge a a'  get_return_edges a 
  obtain Q r p fs where "kind a = Q:rpfs"
    by(fastforce dest!:only_call_get_return_edges)
  with valid_edge a a'  get_return_edges a obtain Q' f' where "kind a' = Q'pf'"
    by(fastforce dest!:call_return_edges)
  from valid_edge a a'  get_return_edges a have "valid_edge a'"
    by(rule get_return_edges_valid)
  from ‹preds (kinds (a#as@[a'])) s obtain cf cfs where [simp]:"s = cf#cfs"
    by(cases s,auto simp:kinds_def)
  from valid_edge a kind a = Q:rpfs obtain ins outs 
    where "(p,ins,outs)  set procs" by(fastforce dest!:callee_in_procs)
  from kind a = Q:rpfs obtain cfx where "transfer (kind a) s = cfx#cf#cfs"
    by simp
  moreover
  from n -assl* n' obtain cfx' 
    where "transfers (kinds as) (cfx#cf#cfs) = cfx'#cf#cfs"
    by(fastforce elim:slp_callstack_length_equal)
  moreover
  from kind a' = Q'pf' valid_edge a' (p,ins,outs)  set procs
  have "fst (hd (transfer (kind a') (cfx'#cf#cfs))) = 
    (fst cf)(ParamDefs (targetnode a') [:=] map (fst cfx') outs)"
    by(simp,simp only:formal_out_THE,fastforce intro:CFG_return_edge_fun)
  ultimately have "fst (hd (transfers (kinds (a#as@[a'])) s)) = 
    (fst cf)(ParamDefs (targetnode a') [:=] map (fst cfx') outs)"
    by(simp add:kinds_def transfers_split)
  with V  set (ParamDefs (targetnode a')) show ?thesis
    by(simp add:fun_upds_notin)
qed



lemma [dest!]: "V  Use (_Entry_)  False"
by(simp add:Entry_empty)

lemma [dest!]: "V  Def (_Entry_)  False"
by(simp add:Entry_empty)


lemma CFG_intra_path_no_Def_equal:
  assumes "n -asι* n'" and "n  set (sourcenodes as). V  Def n"
  and "preds (kinds as) s"
  shows "state_val (transfers (kinds as) s) V = state_val s V"
proof -
  from n -asι* n' have "n -as→* n'" and "a  set as. intra_kind (kind a)"
    by(simp_all add:intra_path_def)
  from this n  set (sourcenodes as). V  Def n ‹preds (kinds as) s
  have "state_val (transfers (kinds as) s) V = state_val s V"
  proof(induct arbitrary:s rule:path.induct)
    case (empty_path n)
    thus ?case by(simp add:sourcenodes_def kinds_def)
  next
    case (Cons_path n'' as n' a n)
    note IH = s. aset as. intra_kind (kind a); 
                    nset (sourcenodes as). V  Def n; preds (kinds as) s 
       state_val (transfers (kinds as) s) V = state_val s V
    from ‹preds (kinds (a#as)) s have "pred (kind a) s"
      and "preds (kinds as) (transfer (kind a) s)" by(simp_all add:kinds_def)
    from nset (sourcenodes (a#as)). V  Def n
    have noDef:"V  Def (sourcenode a)" 
      and all:"nset (sourcenodes as). V  Def n"
      by(auto simp:sourcenodes_def)
    from aset (a#as). intra_kind (kind a)
    have "intra_kind (kind a)" and all':"aset as. intra_kind (kind a)"
      by auto
    from valid_edge a noDef ‹intra_kind (kind a) ‹pred (kind a) s
    have "state_val (transfer (kind a) s) V = state_val s V"
     by -(rule CFG_intra_edge_no_Def_equal)
    with IH[OF all' all ‹preds (kinds as) (transfer (kind a) s)] show ?case
      by(simp add:kinds_def)
  qed
  thus ?thesis by blast
qed


lemma slpa_preds:
  "same_level_path_aux cs as; s = cfsx@cf#cfs; s' = cfsx@cf#cfs'; 
    length cfs = length cfs'; a  set as. valid_edge a; length cs = length cfsx; 
    preds (kinds as) s
   preds (kinds as) s'"
proof(induct arbitrary:s s' cf cfsx rule:slpa_induct)
  case (slpa_empty cs) thus ?case by(simp add:kinds_def)
next
  case (slpa_intra cs a as)
  note IH = s s' cf cfsx. s = cfsx@cf#cfs; s' = cfsx@cf#cfs';
    length cfs = length cfs'; a  set as. valid_edge a; length cs = length cfsx; 
    preds (kinds as) s  preds (kinds as) s'
  from aset (a#as). valid_edge a have "valid_edge a"
    and "a  set as. valid_edge a" by simp_all
  from ‹preds (kinds (a#as)) s have "pred (kind a) s"
    and "preds (kinds as) (transfer (kind a) s)" by(simp_all add:kinds_def)
  show ?case
  proof(cases cfsx)
    case Nil
    with ‹length cs = length cfsx have "length cs = length []" by simp
    from Nil s = cfsx@cf#cfs s' = cfsx@cf#cfs' ‹intra_kind (kind a) 
    obtain cfx where "transfer (kind a) s = []@cfx#cfs"
      and "transfer (kind a) s' = []@cfx#cfs'"
      by(cases "kind a",auto simp:kinds_def intra_kind_def)
    from IH[OF this ‹length cfs = length cfs' a  set as. valid_edge a
      ‹length cs = length [] ‹preds (kinds as) (transfer (kind a) s)]
    have "preds (kinds as) (transfer (kind a) s')" .
    moreover
    from Nil valid_edge a ‹pred (kind a) s s = cfsx@cf#cfs s' = cfsx@cf#cfs'
      ‹length cfs = length cfs'
    have "pred (kind a) s'" by(fastforce intro:CFG_edge_Uses_pred_equal)
    ultimately show ?thesis by(simp add:kinds_def)
  next
    case (Cons x xs)
    with s = cfsx@cf#cfs s' = cfsx@cf#cfs' ‹intra_kind (kind a)
    obtain cfx where "transfer (kind a) s = (cfx#xs)@cf#cfs"
      and "transfer (kind a) s' = (cfx#xs)@cf#cfs'"
      by(cases "kind a",auto simp:kinds_def intra_kind_def)
    from IH[OF this ‹length cfs = length cfs' a  set as. valid_edge a _ 
      ‹preds (kinds as) (transfer (kind a) s)] ‹length cs = length cfsx Cons
    have "preds (kinds as) (transfer (kind a) s')" by simp
    moreover
    from Cons valid_edge a ‹pred (kind a) s s = cfsx@cf#cfs s' = cfsx@cf#cfs'
      ‹length cfs = length cfs' 
    have "pred (kind a) s'" by(fastforce intro:CFG_edge_Uses_pred_equal)
    ultimately show ?thesis by(simp add:kinds_def)
  qed
next
  case (slpa_Call cs a as Q r p fs)
  note IH = s s' cf cfsx. s = cfsx@cf#cfs; s' = cfsx@cf#cfs';
    length cfs = length cfs'; a  set as. valid_edge a; length (a#cs) = length cfsx;
    preds (kinds as) s  preds (kinds as) s'
  from aset (a#as). valid_edge a have "valid_edge a"
    and "a  set as. valid_edge a" by simp_all
  from ‹preds (kinds (a#as)) s have "pred (kind a) s"
    and "preds (kinds as) (transfer (kind a) s)" by(simp_all add:kinds_def)
  from kind a = Q:rpfs s = cfsx@cf#cfs s' = cfsx@cf#cfs' obtain cfx
    where "transfer (kind a) s = (cfx#cfsx)@cf#cfs"
    and "transfer (kind a) s' = (cfx#cfsx)@cf#cfs'" by(cases cfsx) auto
  from IH[OF this ‹length cfs = length cfs' a  set as. valid_edge a _ 
    ‹preds (kinds as) (transfer (kind a) s)] ‹length cs = length cfsx
  have "preds (kinds as) (transfer (kind a) s')" by simp
  moreover
  from valid_edge a ‹pred (kind a) s s = cfsx@cf#cfs s' = cfsx@cf#cfs'
    ‹length cfs = length cfs' have "pred (kind a) s'" 
    by(cases cfsx)(auto intro:CFG_edge_Uses_pred_equal)
  ultimately show ?case by(simp add:kinds_def)
next
  case (slpa_Return cs a as Q p f c' cs')
  note IH = s s' cf cfsx. s = cfsx@cf#cfs; s' = cfsx@cf#cfs';
    length cfs = length cfs'; a  set as. valid_edge a; length cs' = length cfsx; 
    preds (kinds as) s  preds (kinds as) s'
  from aset (a#as). valid_edge a have "valid_edge a"
    and "a  set as. valid_edge a" by simp_all
  from ‹preds (kinds (a#as)) s have "pred (kind a) s"
    and "preds (kinds as) (transfer (kind a) s)" by(simp_all add:kinds_def)
  show ?case
  proof(cases cs')
    case Nil
    with cs = c'#cs' s = cfsx@cf#cfs s' = cfsx@cf#cfs'
      ‹length cs = length cfsx 
    obtain cf' where "s = cf'#cf#cfs" and "s' = cf'#cf#cfs'" by(cases cfsx) auto
    with kind a = Qpf obtain cf'' where "transfer (kind a) s = []@cf''#cfs"
      and "transfer (kind a) s' = []@cf''#cfs'" by auto
    from IH[OF this ‹length cfs = length cfs' a  set as. valid_edge a _ 
      ‹preds (kinds as) (transfer (kind a) s)] Nil
    have "preds (kinds as) (transfer (kind a) s')" by simp
    moreover
    from valid_edge a ‹pred (kind a) s s = cfsx@cf#cfs s' = cfsx@cf#cfs'
      ‹length cfs = length cfs'  have "pred (kind a) s'" 
      by(cases cfsx)(auto intro:CFG_edge_Uses_pred_equal)
    ultimately show ?thesis by(simp add:kinds_def)
  next
    case (Cons cx csx)
    with cs = c'#cs' ‹length cs = length cfsx s = cfsx@cf#cfs s' = cfsx@cf#cfs'
    obtain x x' xs where "s = (x#x'#xs)@cf#cfs" and "s' = (x#x'#xs)@cf#cfs'"
      and "length xs = length csx"
      by(cases cfsx,auto,case_tac list,fastforce+)
    with kind a = Qpf obtain cf' where "transfer (kind a) s = (cf'#xs)@cf#cfs"
      and "transfer (kind a) s' = (cf'#xs)@cf#cfs'"
      by fastforce
    from IH[OF this ‹length cfs = length cfs' a  set as. valid_edge a _ 
      ‹preds (kinds as) (transfer (kind a) s)] Cons ‹length xs = length csx
    have "preds (kinds as) (transfer (kind a) s')" by simp
    moreover
    from valid_edge a ‹pred (kind a) s s = cfsx@cf#cfs s' = cfsx@cf#cfs'
      ‹length cfs = length cfs'  have "pred (kind a) s'" 
      by(cases cfsx)(auto intro:CFG_edge_Uses_pred_equal)
    ultimately show ?thesis by(simp add:kinds_def)
  qed
qed


lemma slp_preds:
  assumes "n -assl* n'" and "preds (kinds as) (cf#cfs)" 
  and "length cfs = length cfs'"
  shows "preds (kinds as) (cf#cfs')"
proof -
  from n -assl* n' have "n -as→* n'" and "same_level_path_aux [] as"
    by(simp_all add:slp_def same_level_path_def)
  from n -as→* n' have "a  set as. valid_edge a" by(rule path_valid_edges)
  with ‹same_level_path_aux [] as ‹preds (kinds as) (cf#cfs) 
    ‹length cfs = length cfs'
  show ?thesis by(fastforce elim!:slpa_preds)
qed
end


end

Theory CFGExit_wf

theory CFGExit_wf imports CFGExit CFG_wf begin

subsection ‹New well-formedness lemmas using (_Exit_)›

locale CFGExit_wf = CFGExit sourcenode targetnode kind valid_edge Entry 
    get_proc get_return_edges procs Main Exit +
  CFG_wf sourcenode targetnode kind valid_edge Entry 
    get_proc get_return_edges procs Main Def Use ParamDefs ParamUses
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  ('var,'val,'ret,'pname) edge_kind" 
  and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')")  and get_proc :: "'node  'pname"
  and get_return_edges :: "'edge  'edge set"
  and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname"
  and Exit::"'node"  ("'('_Exit'_')") 
  and Def :: "'node  'var set" and Use :: "'node  'var set"
  and ParamDefs :: "'node  'var list" 
  and ParamUses :: "'node  'var set list" +
  assumes Exit_empty:"Def (_Exit_) = {}  Use (_Exit_) = {}"

begin

lemma Exit_Use_empty [dest!]: "V  Use (_Exit_)  False"
by(simp add:Exit_empty)

lemma Exit_Def_empty [dest!]: "V  Def (_Exit_)  False"
by(simp add:Exit_empty)

end

end

Theory SemanticsCFG

section ‹CFG and semantics conform›

theory SemanticsCFG imports CFG begin

locale CFG_semantics_wf = CFG sourcenode targetnode kind valid_edge Entry 
    get_proc get_return_edges procs Main
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  ('var,'val,'ret,'pname) edge_kind" 
  and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')")  and get_proc :: "'node  'pname"
  and get_return_edges :: "'edge  'edge set"
  and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname" +
  fixes sem::"'com  ('var  'val) list  'com  ('var  'val) list  bool" 
    ("((1_,/_) / (1_,/_))" [0,0,0,0] 81)
  fixes identifies::"'node  'com  bool" ("_  _" [51,0] 80)
  assumes fundamental_property:
    "n  c; c,[cf]  c',s' 
      n' as. n -as* n'  n'  c'  preds (kinds as) [(cf,undefined)] 
              transfers (kinds as) [(cf,undefined)] = cfs'  map fst cfs' = s'"


end

Theory ReturnAndCallNodes

section ‹Return and their corresponding call nodes›

theory ReturnAndCallNodes imports CFG begin

context CFG begin

subsection ‹Defining return_node›

definition return_node :: "'node  bool"
  where "return_node n  a a'. valid_edge a  n = targetnode a  
    valid_edge a'  a  get_return_edges a'"


lemma return_node_determines_call_node:
  assumes "return_node n"
  shows "∃!n'. a a'. valid_edge a  n' = sourcenode a  valid_edge a'  
    a'  get_return_edges a  n = targetnode a'"
proof(rule ex_ex1I)
  from ‹return_node n
  show "n' a a'. valid_edge a  n' = sourcenode a  valid_edge a'  
    a'  get_return_edges a  n = targetnode a'"
    by(simp add:return_node_def) blast
next
  fix n' nx
  assume "a a'. valid_edge a  n' = sourcenode a  valid_edge a'  
    a'  get_return_edges a  n = targetnode a'"
    and "a a'. valid_edge a  nx = sourcenode a  valid_edge a'  
    a'  get_return_edges a  n = targetnode a'"
  then obtain a a' ax ax' where "valid_edge a" and "n' = sourcenode a"
    and "valid_edge a'" and "a'  get_return_edges a"
    and "n = targetnode a'" and "valid_edge ax" and "nx = sourcenode ax" 
   and "valid_edge ax'" and "ax'  get_return_edges ax"
    and "n = targetnode ax'"
    by blast
  from valid_edge a a'  get_return_edges a have "valid_edge a'"
    by(rule get_return_edges_valid)
  from valid_edge a a'  get_return_edges a obtain a''
    where intra_edge1:"valid_edge a''" "sourcenode a'' = sourcenode a"
    "targetnode a'' = targetnode a'" "kind a'' = (λcf. False)"
    by(fastforce dest:call_return_node_edge)
  from valid_edge ax ax'  get_return_edges ax obtain ax''
    where intra_edge2:"valid_edge ax''" "sourcenode ax'' = sourcenode ax"
    "targetnode ax'' = targetnode ax'" "kind ax'' = (λcf. False)"
    by(fastforce dest:call_return_node_edge)
  from valid_edge a a'  get_return_edges a 
  obtain Q r p fs where "kind a = Q:rpfs"
    by(fastforce dest!:only_call_get_return_edges)
  with valid_edge a a'  get_return_edges a obtain Q' p f' 
    where "kind a' = Q'pf'" by(fastforce dest!:call_return_edges)
  with valid_edge a'
  have "∃!a''. valid_edge a''  targetnode a'' = targetnode a'  intra_kind(kind a'')"
    by(rule return_only_one_intra_edge)
  with intra_edge1 intra_edge2 n = targetnode a' n = targetnode ax'
  have "a'' = ax''" by(fastforce simp:intra_kind_def)
  with sourcenode a'' = sourcenode a sourcenode ax'' = sourcenode ax
    n' = sourcenode a nx = sourcenode ax
  show "n' = nx" by simp
qed


lemma return_node_THE_call_node:
  "return_node n; valid_edge a; valid_edge a'; a'  get_return_edges a; 
  n = targetnode a'
   (THE n'. a a'. valid_edge a  n' = sourcenode a  valid_edge a'  
  a'  get_return_edges a  n = targetnode a') = sourcenode a"
  by(fastforce intro!:the1_equality return_node_determines_call_node)


subsection ‹Defining call nodes belonging to a certain return_node›

definition call_of_return_node :: "'node  'node  bool"
  where "call_of_return_node n n'  a a'. return_node n  
  valid_edge a  n' = sourcenode a  valid_edge a' 
  a'  get_return_edges a  n = targetnode a'"


lemma return_node_call_of_return_node:
  "return_node n  ∃!n'. call_of_return_node n n'"
  by -(frule return_node_determines_call_node,unfold call_of_return_node_def,simp)


lemma call_of_return_nodes_det [dest]:
  assumes "call_of_return_node n n'" and "call_of_return_node n n''"
  shows "n' = n''"
proof -
  from ‹call_of_return_node n n' have "return_node n" 
    by(simp add:call_of_return_node_def)
  hence "∃!n'. call_of_return_node n n'" by(rule return_node_call_of_return_node)
  with ‹call_of_return_node n n' ‹call_of_return_node n n''
  show ?thesis by auto
qed



lemma get_return_edges_call_of_return_nodes:
  "valid_call_list cs m; valid_return_list rs m;
    i < length rs. rs!i  get_return_edges (cs!i); length rs = length cs
   i<length cs. call_of_return_node (targetnodes rs!i) (sourcenode (cs!i))"
proof(induct cs arbitrary:m rs)
  case Nil thus ?case by fastforce
next
  case (Cons c' cs')
  note IH = m rs. valid_call_list cs' m; valid_return_list rs m;
    i<length rs. rs ! i  get_return_edges (cs' ! i); length rs = length cs'
     i<length cs'. call_of_return_node (targetnodes rs ! i) (sourcenode (cs'!i))
  from ‹length rs = length (c' # cs') obtain r' rs' where "rs = r' # rs'"
    and "length rs' = length cs'" by(cases rs) auto
  with i<length rs. rs ! i  get_return_edges ((c' # cs') ! i)
  have "i<length rs'. rs' ! i  get_return_edges (cs' ! i)"
    and "r'  get_return_edges c'" by auto
  from ‹valid_call_list (c'#cs') m have "valid_edge c'"
    by(fastforce simp:valid_call_list_def)
  from this r'  get_return_edges c'
  have "get_proc (sourcenode c') = get_proc (targetnode r')"
    by(rule get_proc_get_return_edge)
  from ‹valid_call_list (c'#cs') m
  have "valid_call_list cs' (sourcenode c')"
    apply(clarsimp simp:valid_call_list_def)
    apply(hypsubst_thin)
    apply(erule_tac x="c'#cs'" in allE) apply clarsimp
    by(case_tac cs')(auto simp:sourcenodes_def)
  from ‹valid_return_list rs m rs = r' # rs' 
    get_proc (sourcenode c') = get_proc (targetnode r')
  have "valid_return_list rs' (sourcenode c')"
    apply(clarsimp simp:valid_return_list_def)
    apply(erule_tac x="r'#cs'" in allE) apply clarsimp
    by(case_tac cs')(auto simp:targetnodes_def)
  from IH[OF ‹valid_call_list cs' (sourcenode c') 
    ‹valid_return_list rs' (sourcenode c')
    i<length rs'. rs' ! i  get_return_edges (cs' ! i) ‹length rs' = length cs']
  have all:"i<length cs'.
    call_of_return_node (targetnodes rs' ! i) (sourcenode (cs' ! i))" .
  from valid_edge c' r'  get_return_edges c' have "valid_edge r'" 
    by(rule get_return_edges_valid)
  from valid_edge r' valid_edge c' r'  get_return_edges c'
  have "return_node (targetnode r')" by(fastforce simp:return_node_def)
  with valid_edge c' r'  get_return_edges c' valid_edge r'
  have "call_of_return_node (targetnode r') (sourcenode c')"
    by(simp add:call_of_return_node_def) blast
  with all rs = r' # rs' show ?case
    by auto(case_tac i,auto simp:targetnodes_def)
qed


end

end

Theory Observable

section ‹Observable Sets of Nodes›

theory Observable imports ReturnAndCallNodes begin

context CFG begin


subsection ‹Intraprocedural observable sets›

inductive_set obs_intra :: "'node  'node set  'node set" 
for n::"'node" and S::"'node set"
where obs_intra_elem:
  "n -asι* n'; nx  set(sourcenodes as). nx  S; n'  S  n'  obs_intra n S"


lemma obs_intraE:
  assumes "n'  obs_intra n S"
  obtains as where "n -asι* n'" and "nx  set(sourcenodes as). nx  S" and "n'  S"
  using n'  obs_intra n S
  by(fastforce elim:obs_intra.cases)


lemma n_in_obs_intra:
  assumes "valid_node n" and "n  S" shows "obs_intra n S = {n}"
proof -
  from ‹valid_node n have "n -[]→* n" by(rule empty_path)
  hence "n -[]ι* n" by(simp add:intra_path_def)
  with n  S have "n  obs_intra n S" 
    by(fastforce elim:obs_intra_elem simp:sourcenodes_def)
  { fix n' assume "n'  obs_intra n S"
    have "n' = n"
    proof(rule ccontr)
      assume "n'  n"
      from n'  obs_intra n S obtain as where "n -asι* n'"
        and "nx  set(sourcenodes as). nx  S"
        and "n'  S" by(fastforce elim:obs_intra.cases)
      from n -asι* n' have "n -as→* n'" by(simp add:intra_path_def)
      from this nx  set(sourcenodes as). nx  S n'  n n  S
      show False
      proof(induct rule:path.induct)
        case (Cons_path n'' as n' a n)
        from nxset (sourcenodes (a#as)). nx  S sourcenode a = n
        have "n  S" by(simp add:sourcenodes_def)
        with n  S show False by simp
      qed simp
    qed }
  with n  obs_intra n S show ?thesis by fastforce
qed


lemma in_obs_intra_valid:
  assumes "n'  obs_intra n S" shows "valid_node n" and "valid_node n'"
  using n'  obs_intra n S
  by(auto elim!:obs_intraE intro:path_valid_node simp:intra_path_def)


lemma edge_obs_intra_subset:
  assumes "valid_edge a" and "intra_kind (kind a)" and "sourcenode a  S"
  shows "obs_intra (targetnode a) S  obs_intra (sourcenode a) S"
proof
  fix n assume "n  obs_intra (targetnode a) S"
  then obtain as where "targetnode a -asι* n" 
    and all:"nx  set(sourcenodes as). nx  S" and "n  S" by(erule obs_intraE)
  from valid_edge a ‹intra_kind (kind a) targetnode a -asι* n
  have "sourcenode a -[a]@asι* n" by(fastforce intro:Cons_path simp:intra_path_def)
  moreover
  from all sourcenode a  S have "nx  set(sourcenodes (a#as)). nx  S"
    by(simp add:sourcenodes_def)
  ultimately show "n  obs_intra (sourcenode a) S" using n  S
    by(fastforce intro:obs_intra_elem)
qed


lemma path_obs_intra_subset:
  assumes "n -asι* n'" and "n'  set(sourcenodes as). n'  S"
  shows "obs_intra n' S  obs_intra n S"
proof -
  from n -asι* n' have "n -as→* n'" and "a  set as. intra_kind (kind a)"
    by(simp_all add:intra_path_def)
  from this n'  set(sourcenodes as). n'  S show ?thesis
  proof(induct rule:path.induct)
    case (Cons_path n'' as n' a n)
    note IH = aset as. intra_kind (kind a); n'set (sourcenodes as). n'  S
       obs_intra n' S  obs_intra n'' S
    from n'set (sourcenodes (a#as)). n'  S 
    have all:"n'set (sourcenodes as). n'  S" and "sourcenode a  S"
      by(simp_all add:sourcenodes_def)
    from a  set (a#as). intra_kind (kind a)
    have "intra_kind (kind a)" and "a  set as. intra_kind (kind a)"
      by(simp_all add:intra_path_def)
    from IH[OF a  set as. intra_kind (kind a) all]
    have "obs_intra n' S  obs_intra n'' S" .
    from valid_edge a ‹intra_kind (kind a) targetnode a = n''
      sourcenode a = n sourcenode a  S
    have "obs_intra n'' S  obs_intra n S" by(fastforce dest:edge_obs_intra_subset)
    with ‹obs_intra n' S  obs_intra n'' S show ?case by fastforce
  qed simp
qed


lemma path_ex_obs_intra:
  assumes "n -asι* n'" and "n'  S"
  obtains m where "m  obs_intra n S"
proof(atomize_elim)
  show "m. m  obs_intra n S"
  proof(cases "nx  set(sourcenodes as). nx  S")
    case True
    with n -asι* n' n'  S have "n'  obs_intra n S" by -(rule obs_intra_elem)
    thus ?thesis by fastforce
  next
    case False
    hence "nx  set(sourcenodes as). nx  S" by fastforce
    then obtain nx ns ns' where "sourcenodes as = ns@nx#ns'"
      and "nx  S" and "n'  set ns. n'  S"
      by(fastforce elim!:split_list_first_propE)
    from ‹sourcenodes as = ns@nx#ns' obtain as' a as'' 
      where "ns = sourcenodes as'"
      and "as = as'@a#as''" and "sourcenode a = nx"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    with n -asι* n' have "n -as'ι* nx"
      by(fastforce dest:path_split simp:intra_path_def)
    with nx  S n'  set ns. n'  S ns = sourcenodes as' 
    have "nx  obs_intra n S" by(fastforce intro:obs_intra_elem)
    thus ?thesis by fastforce
  qed
qed


subsection ‹Interprocedural observable sets restricted to the slice›


fun obs :: "'node list  'node set  'node list set" 
  where "obs [] S = {}"
  | "obs (n#ns) S = (let S' = obs_intra n S in 
  (if (S' = {}  (n'  set ns. nx. call_of_return_node n' nx  nx  S)) 
   then obs ns S else (λnx. nx#ns) ` S'))"


lemma obsI:
  assumes "n'  obs_intra n S"
  and "nx  set nsx'. nx'. call_of_return_node nx nx'  nx'  S"
  shows "ns = nsx@n#nsx'; xs x xs'. nsx = xs@x#xs'  obs_intra x S  {}
      (x''  set (xs'@[n]). nx. call_of_return_node x'' nx  nx  S)
   n'#nsx'  obs ns S"
proof(induct ns arbitrary:nsx)
case (Cons x xs)
  note IH = nsx. xs = nsx@n#nsx'; 
    xs x xs'. nsx = xs @ x # xs'  obs_intra x S  {} 
    (x''set (xs'@[n]). nx. call_of_return_node x'' nx  nx  S)
     n'#nsx'  obs xs S
  note nsx = xs x xs'. nsx = xs @ x # xs'  obs_intra x S  {} 
    (x''set (xs' @ [n]). nx. call_of_return_node x'' nx  nx  S)
  show ?case
  proof(cases nsx)
    case Nil
    with x#xs = nsx@n#nsx' have "n = x" and "xs = nsx'" by simp_all
    with n'  obs_intra n S
      nxset nsx'. nx'. call_of_return_node nx nx'  nx'  S
    show ?thesis by(fastforce simp:Let_def)
  next
    case (Cons z zs)
    with x#xs = nsx@n#nsx' have [simp]:"x = z" "xs = zs@n#nsx'" by simp_all
    from nsx Cons
    have "xs x xs'. zs = xs @ x # xs'  obs_intra x S  {} 
      (x''set (xs' @ [n]). nx. call_of_return_node x'' nx  nx  S)"
      by clarsimp(erule_tac x="z#xs" in allE,auto)
    from IH[OF xs = zs@n#nsx' this] have "n'#nsx'  obs xs S" by simp
    show ?thesis
    proof(cases "obs_intra z S = {}")
      case True
      with Cons n'#nsx'  obs xs S show ?thesis by(simp add:Let_def)
    next
      case False
      from nsx Cons
      have "obs_intra z S  {} 
        (x''set (zs @ [n]). nx. call_of_return_node x'' nx  nx  S)"
        by clarsimp
      with False have "x''set (zs @ [n]). nx. call_of_return_node x'' nx  nx  S"
        by simp
      with xs = zs@n#nsx' 
      have "n'  set xs. nx. call_of_return_node n' nx  nx  S" by fastforce
      with Cons n'#nsx'  obs xs S show ?thesis by(simp add:Let_def)
    qed
  qed
qed simp



lemma obsE [consumes 2]:
  assumes "ns'  obs ns S" and "n  set (tl ns). return_node n"
  obtains nsx n nsx' n' where "ns = nsx@n#nsx'" and "ns' = n'#nsx'" 
  and "n'  obs_intra n S" 
  and "nx  set nsx'. nx'. call_of_return_node nx nx'  nx'  S"
  and "xs x xs'. nsx = xs@x#xs'  obs_intra x S  {}
   (x''  set (xs'@[n]). nx. call_of_return_node x'' nx  nx  S)"
proof(atomize_elim)
  from ns'  obs ns S n  set (tl ns). return_node n
  show "nsx n nsx' n'. ns = nsx @ n # nsx'  ns' = n' # nsx' 
    n'  obs_intra n S  (nxset nsx'. nx'. call_of_return_node nx nx'  nx'  S) 
    (xs x xs'. nsx = xs @ x # xs'  obs_intra x S  {} 
    (x''set (xs' @ [n]). nx. call_of_return_node x'' nx  nx  S))"
  proof(induct ns)
    case Nil thus ?case by simp
  next
    case (Cons nx ns'')
    note IH = ns'  obs ns'' S; aset (tl ns''). return_node a
       nsx n nsx' n'. ns'' = nsx @ n # nsx'  ns' = n' # nsx' 
      n'  obs_intra n S  
      (nxset nsx'. nx'. call_of_return_node nx nx'  nx'  S) 
      (xs x xs'. nsx = xs @ x # xs'  obs_intra x S  {} 
         (x''set (xs' @ [n]). nx. call_of_return_node x'' nx  nx  S))
    from aset (tl (nx # ns'')). return_node a have "n  set ns''. return_node n"
      by simp
    show ?case
    proof(cases ns'')
      case Nil
      with ns'  obs (nx#ns'') S obtain x where "ns' = [x]" and "x  obs_intra nx S"
        by(auto simp:Let_def split:if_split_asm)
      with Nil show ?thesis by fastforce
    next
      case Cons
      with n  set ns''. return_node n have "aset (tl ns''). return_node a"
        by simp
      show ?thesis
      proof(cases "n'  set ns''. nx'. call_of_return_node n' nx'  nx'  S")
        case True
        with ns'  obs (nx#ns'') S have "ns'  obs ns'' S" by simp
        from IH[OF this aset (tl ns''). return_node a]
        obtain nsx n nsx' n' where split:"ns'' = nsx @ n # nsx'"
          "ns' = n' # nsx'" "n'  obs_intra n S"
          "nxset nsx'. nx'. call_of_return_node nx nx'  nx'  S"
          and imp:"xs x xs'. nsx = xs @ x # xs'  obs_intra x S  {} 
          (x''set (xs' @ [n]). nx. call_of_return_node x'' nx  nx  S)"
          by blast
        from True ns'' = nsx @ n # nsx'
          nxset nsx'. nx'. call_of_return_node nx nx'  nx'  S
        have "(nx'. call_of_return_node n nx'  nx'  S) 
          (n'set nsx. nx'. call_of_return_node n' nx'  nx'  S)" by fastforce
        thus ?thesis
        proof
          assume "nx'. call_of_return_node n nx'  nx'  S"
          with split show ?thesis by clarsimp
        next
          assume "n'set nsx. nx'. call_of_return_node n' nx'  nx'  S"
          with imp have "xs x xs'. nx#nsx = xs @ x # xs'  obs_intra x S  {} 
          (x''set (xs' @ [n]). nx. call_of_return_node x'' nx  nx  S)"
            apply clarsimp apply(case_tac xs) apply auto
            by(erule_tac x="list" in allE,auto)+
          with split Cons show ?thesis by auto
        qed
      next
        case False
        hence "n'set ns''. nx'. call_of_return_node n' nx'  nx'  S" by simp
        show ?thesis
        proof(cases "obs_intra nx S = {}")
          case True
          with ns'  obs (nx#ns'') S have "ns'  obs ns'' S" by simp
          from IH[OF this aset (tl ns''). return_node a]
          obtain nsx n nsx' n' where split:"ns'' = nsx @ n # nsx'"
            "ns' = n' # nsx'" "n'  obs_intra n S"
            "nxset nsx'. nx'. call_of_return_node nx nx'  nx'  S"
            and imp:"xs x xs'. nsx = xs @ x # xs'  obs_intra x S  {} 
            (x''set (xs' @ [n]). nx. call_of_return_node x'' nx  nx  S)"
            by blast
          from True imp Cons 
          have "xs x xs'. nx#nsx = xs @ x # xs'  obs_intra x S  {} 
            (x''set (xs' @ [n]). nx. call_of_return_node x'' nx  nx  S)"
            by clarsimp (hypsubst_thin,case_tac xs,clarsimp+,erule_tac x="list" in allE,auto)
          with split Cons show ?thesis by auto
        next
          case False
          with n'set ns''. nx'. call_of_return_node n' nx'  nx'  S
            ns'  obs (nx # ns'') S
          obtain nx'' where "ns' = nx''#ns''" and "nx''  obs_intra nx S"
          by(fastforce simp:Let_def split:if_split_asm)
          { fix n' assume "n'set ns''"
            with n  set ns''. return_node n have "return_node n'" by simp
            hence "∃!n''. call_of_return_node n' n''" 
              by(rule return_node_call_of_return_node)
            from n'set ns'' 
              n'set ns''. nx'. call_of_return_node n' nx'  nx'  S
            have "nx'. call_of_return_node n' nx'  nx'  S" by simp
            with ∃!n''. call_of_return_node n' n'' 
            have "n''. call_of_return_node n' n''  n''  S" by fastforce }
          with ns' = nx''#ns'' nx''  obs_intra nx S show ?thesis by fastforce
        qed
      qed
    qed
  qed
qed



lemma obs_split_det:
  assumes "xs@x#xs' = ys@y#ys'" 
  and "obs_intra x S  {}" 
  and "x'  set xs'. x''. call_of_return_node x' x''  x''  S"
  and "zs z zs'. xs = zs@z#zs'  obs_intra z S  {}
   (z''  set (zs'@[x]). nx. call_of_return_node z'' nx  nx  S)"
  and "obs_intra y S  {}" 
  and "y'  set ys'. y''. call_of_return_node y' y''  y''  S"
  and "zs z zs'. ys = zs@z#zs'  obs_intra z S  {}
   (z''  set (zs'@[y]). ny. call_of_return_node z'' ny  ny  S)"
  shows "xs = ys  x = y  xs' = ys'"
using assms
proof(induct xs arbitrary:ys)
  case Nil
  note impy = zs z zs'. ys = zs@z#zs'  obs_intra z S  {}
     (z''  set (zs'@[y]). ny. call_of_return_node z'' ny  ny  S)
  show ?case
  proof(cases "ys = []")
    case True
    with Nil []@x#xs' = ys@y#ys' show ?thesis by simp
  next
    case False
    with [] @ x # xs' = ys @ y # ys' 
    obtain zs where "x#zs = ys" and "xs' = zs@y#ys'" by(auto simp:Cons_eq_append_conv)
    from x#zs = ys ‹obs_intra x S  {} impy 
    have "z''  set (zs@[y]). ny. call_of_return_node z'' ny  ny  S"
      by blast
    with xs' = zs@y#ys' x'  set xs'. x''. call_of_return_node x' x''  x''  S
    have False by fastforce
    thus ?thesis by simp
  qed
next
  case (Cons w ws)
  note IH = ys. ws @ x # xs' = ys @ y # ys'; obs_intra x S  {};
    x'set xs'. x''. call_of_return_node x' x''  x''  S;
    zs z zs'. ws = zs @ z # zs'  obs_intra z S  {} 
      (z''set (zs' @ [x]). nx. call_of_return_node z'' nx  nx  S);
    obs_intra y S  {}; y'set ys'. y''. call_of_return_node y' y''  y''  S;
    zs z zs'. ys = zs @ z # zs'  obs_intra z S  {} 
      (z''set (zs' @ [y]). ny. call_of_return_node z'' ny  ny  S)    
     ws = ys  x = y  xs' = ys'
  note impw = zs z zs'. w # ws = zs @ z # zs'  obs_intra z S  {} 
    (z''set (zs' @ [x]). nx. call_of_return_node z'' nx  nx  S)
  note impy = zs z zs'. ys = zs @ z # zs'  obs_intra z S  {} 
    (z''set (zs' @ [y]). ny. call_of_return_node z'' ny  ny  S)
  show ?case
  proof(cases ys)
    case Nil
    with (w#ws) @ x # xs' = ys @ y # ys' have "y = w" and "ys' = ws @ x # xs'"
      by simp_all
    from y = w ‹obs_intra y S  {} impw
    have "z''set (ws @ [x]). nx. call_of_return_node z'' nx  nx  S" by blast
    with ys' = ws @ x # xs' 
      y'set ys'. y''. call_of_return_node y' y''  y''  S
    have False by fastforce
    thus ?thesis by simp
  next
    case (Cons w' ws')
    with (w # ws) @ x # xs' = ys @ y # ys' have "w = w'"
      and "ws @ x # xs' = ws' @ y # ys'" by simp_all
    from impw have imp1:"zs z zs'. ws = zs @ z # zs'  obs_intra z S  {} 
      (z''set (zs' @ [x]). nx. call_of_return_node z'' nx  nx  S)"
      by clarsimp(erule_tac x="w#zs" in allE,clarsimp)
    from Cons impy have imp2:"zs z zs'. ws' = zs @ z # zs'  obs_intra z S  {} 
      (z''set (zs' @ [y]). ny. call_of_return_node z'' ny  ny  S)"
      by clarsimp(erule_tac x="w'#zs" in allE,clarsimp)
    from IH[OF ws @ x # xs' = ws' @ y # ys' ‹obs_intra x S  {}
      x'set xs'. x''. call_of_return_node x' x''  x''  S imp1
      ‹obs_intra y S  {} y'set ys'. y''. call_of_return_node y' y''  y''  S 
      imp2]
    have "ws = ws'  x = y  xs' = ys'" .
    with w = w' Cons show ?thesis by simp
  qed
qed


lemma in_obs_valid:
  assumes "ns'  obs ns S" and "n  set ns. valid_node n"
  shows "n  set ns'. valid_node n"
  using ns'  obs ns S n  set ns. valid_node n
  by(induct ns)(auto intro:in_obs_intra_valid simp:Let_def split:if_split_asm)



end

end

Theory Postdomination

section ‹Postdomination›

theory Postdomination imports CFGExit begin

text ‹For static interprocedural slicing, we only consider standard control 
  dependence, hence we only need standard postdomination.›

locale Postdomination = CFGExit sourcenode targetnode kind valid_edge Entry 
    get_proc get_return_edges procs Main Exit
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  ('var,'val,'ret,'pname) edge_kind" 
  and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')")  and get_proc :: "'node  'pname"
  and get_return_edges :: "'edge  'edge set"
  and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname"
  and Exit::"'node"  ("'('_Exit'_')") +
  assumes Entry_path:"valid_node n  as. (_Entry_) -as* n"
  and Exit_path:"valid_node n  as. n -as* (_Exit_)"
  and method_exit_unique:
    "method_exit n; method_exit n'; get_proc n = get_proc n'  n = n'"

begin

lemma get_return_edges_unique:
  assumes "valid_edge a" and "a'  get_return_edges a" and "a''  get_return_edges a"
  shows "a' = a''"
proof -
  from valid_edge a a'  get_return_edges a 
  obtain Q r p fs where "kind a = Q:rpfs"
    by(fastforce dest!:only_call_get_return_edges)
  with valid_edge a a'  get_return_edges a obtain Q' f' where "kind a' = Q'pf'"
    by(fastforce dest!:call_return_edges)
  from valid_edge a a'  get_return_edges a have "valid_edge a'" 
    by(rule get_return_edges_valid)
  from this kind a' = Q'pf' have "get_proc (sourcenode a') = p" 
    by(rule get_proc_return)
  from valid_edge a' kind a' = Q'pf' have "method_exit (sourcenode a')"
    by(fastforce simp:method_exit_def)
  from valid_edge a a''  get_return_edges a kind a = Q:rpfs
  obtain Q'' f'' where "kind a'' = Q''pf''" by(fastforce dest!:call_return_edges)
  from valid_edge a a''  get_return_edges a have "valid_edge a''" 
    by(rule get_return_edges_valid)
  from this kind a'' = Q''pf'' have "get_proc (sourcenode a'') = p" 
    by(rule get_proc_return)
  from valid_edge a'' kind a'' = Q''pf'' have "method_exit (sourcenode a'')"
    by(fastforce simp:method_exit_def)
  with ‹method_exit (sourcenode a') get_proc (sourcenode a') = p
    get_proc (sourcenode a'') = p have "sourcenode a' = sourcenode a''"
    by(fastforce elim!:method_exit_unique)
  from valid_edge a a'  get_return_edges a
  obtain ax' where "valid_edge ax'" and "sourcenode ax' = sourcenode a"
    and "targetnode ax' = targetnode a'" and "intra_kind(kind ax')"
    by -(drule call_return_node_edge,auto simp:intra_kind_def)
  from valid_edge a a''  get_return_edges a
  obtain ax'' where "valid_edge ax''" and "sourcenode ax'' = sourcenode a"
    and "targetnode ax'' = targetnode a''" and "intra_kind(kind ax'')"
    by -(drule call_return_node_edge,auto simp:intra_kind_def)
  from valid_edge a kind a = Q:rpfs valid_edge ax' 
    sourcenode ax' = sourcenode a ‹intra_kind(kind ax')
    valid_edge ax'' sourcenode ax'' = sourcenode a ‹intra_kind(kind ax'')
  have "ax' = ax''" by -(drule call_only_one_intra_edge,auto)
  with targetnode ax' = targetnode a' targetnode ax'' = targetnode a''
  have "targetnode a' = targetnode a''" by simp
  with valid_edge a' valid_edge a'' sourcenode a' = sourcenode a''
  show ?thesis by(rule edge_det)
qed


definition postdominate :: "'node  'node  bool" ("_ postdominates _" [51,0])
where postdominate_def:"n' postdominates n  
  (valid_node n  valid_node n' 
  (as pex. (n -asι* pex  method_exit pex)  n'  set (sourcenodes as)))"


lemma postdominate_implies_inner_path: 
  assumes "n' postdominates n" 
  obtains as where "n -asι* n'" and "n'  set (sourcenodes as)"
proof(atomize_elim)
  from n' postdominates n have "valid_node n"
    and all:"as pex. (n -asι* pex  method_exit pex)  n'  set (sourcenodes as)"
    by(auto simp:postdominate_def)
  from ‹valid_node n obtain asx where "n -asx* (_Exit_)" by(auto dest:Exit_path)
  then obtain as where "n -as* (_Exit_)"
    and "a  set as. intra_kind(kind a)  (Q f p. kind a = Qpf)"
    by -(erule valid_Exit_path_descending_path)
  show "as. n -asι* n'  n'  set (sourcenodes as)"
  proof(cases "a  set as. Q f p. kind a = Qpf")
    case True
    then obtain asx ax asx' where [simp]:"as = asx@ax#asx'" 
      and "Q f p. kind ax = Qpf" and "a  set asx. Q f p. kind a  Qpf"
      by -(erule split_list_first_propE,simp)
    with a  set as. intra_kind(kind a)  (Q f p. kind a = Qpf)
    have "a  set asx. intra_kind(kind a)" by auto
    from n -as* (_Exit_) have "n -asx* sourcenode ax"
      and "valid_edge ax" by(auto dest:vp_split)
    from n -asx* sourcenode ax a  set asx. intra_kind(kind a)
    have "n -asxι* sourcenode ax" by(simp add:vp_def intra_path_def)
    from valid_edge ax Q f p. kind ax = Qpf 
    have "method_exit (sourcenode ax)" by(fastforce simp:method_exit_def)
    with n -asxι* sourcenode ax all have "n'  set (sourcenodes asx)" by fastforce
    then obtain xs ys where "sourcenodes asx = xs@n'#ys" and "n'  set xs"
      by(fastforce dest:split_list_first)
    then obtain as' a as'' where "xs = sourcenodes as'"
      and [simp]:"asx = as'@a#as''" and "sourcenode a = n'"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from n -asxι* sourcenode ax have "n -as'ι* sourcenode a"
      by(fastforce dest:path_split simp:intra_path_def)
    with sourcenode a = n' n'  set xs xs = sourcenodes as'
    show ?thesis by fastforce
  next
    case False
    with a  set as. intra_kind(kind a)  (Q f p. kind a = Qpf)
    have "a  set as. intra_kind(kind a)" by fastforce
    with n -as* (_Exit_) all have "n'  set (sourcenodes as)"
      by(auto simp:vp_def intra_path_def simp:method_exit_def)
    then obtain xs ys where "sourcenodes as = xs@n'#ys" and "n'  set xs"
      by(fastforce dest:split_list_first)
    then obtain as' a as'' where "xs = sourcenodes as'"
      and [simp]:"as = as'@a#as''" and "sourcenode a = n'"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from n -as* (_Exit_) a  set as. intra_kind(kind a) as = as'@a#as''
    have "n -as'ι* sourcenode a"
      by(fastforce dest:path_split simp:vp_def intra_path_def)
    with sourcenode a = n' n'  set xs xs = sourcenodes as'
    show ?thesis by fastforce
  qed
qed


lemma postdominate_variant:
  assumes "n' postdominates n" 
  shows "as. n -as* (_Exit_)  n'  set (sourcenodes as)"
proof -
  from n' postdominates n
  have all:"as pex. (n -asι* pex  method_exit pex)  n'  set (sourcenodes as)"
    by(simp add:postdominate_def)
  { fix as assume "n -as* (_Exit_)"
    then obtain as' pex where "n -as'ι* pex" and "method_exit pex"
      and "set(sourcenodes as')  set(sourcenodes as)"
      by(erule valid_Exit_path_intra_path)
    from n -as'ι* pex ‹method_exit pex n' postdominates n
    have "n'  set (sourcenodes as')" by(fastforce simp:postdominate_def)
    with ‹set(sourcenodes as')  set(sourcenodes as)
    have "n'  set (sourcenodes as)" by fastforce }
  thus ?thesis by simp
qed


lemma postdominate_refl:
  assumes "valid_node n" and "¬ method_exit n" shows "n postdominates n"
using ‹valid_node n
proof(induct rule:valid_node_cases)
  case Entry
  { fix as pex assume "(_Entry_) -asι* pex" and "method_exit pex"
    from ‹method_exit pex have "(_Entry_)  set (sourcenodes as)"
    proof(rule method_exit_cases)
      assume "pex = (_Exit_)"
      with (_Entry_) -asι* pex have "as  []" 
        apply(clarsimp simp:intra_path_def) apply(erule path.cases)
        by (drule sym,simp,drule Exit_noteq_Entry,auto)
      with (_Entry_) -asι* pex have "hd (sourcenodes as) = (_Entry_)" 
        by(fastforce intro:path_sourcenode simp:intra_path_def)
      with as  []show ?thesis by(fastforce intro:hd_in_set simp:sourcenodes_def)
    next
      fix a Q p f assume "pex = sourcenode a" and "valid_edge a" and "kind a = Qpf"
      from (_Entry_) -asι* pex have "get_proc (_Entry_) = get_proc pex"
        by(rule intra_path_get_procs)
      hence "get_proc pex = Main" by(simp add:get_proc_Entry)
      from valid_edge a kind a = Qpf have "get_proc (sourcenode a) = p"
        by(rule get_proc_return)
      with pex = sourcenode a get_proc pex = Main have "p = Main" by simp
      with valid_edge a kind a = Qpf have False
        by simp (rule Main_no_return_source)
      thus ?thesis by simp
    qed }
  with Entry show ?thesis 
    by(fastforce intro:empty_path simp:postdominate_def intra_path_def)
next
  case Exit
  with ¬ method_exit n have False by(simp add:method_exit_def)
  thus ?thesis by simp
next
  case inner
  show ?thesis
  proof(cases "as. n -as* (_Exit_)")
    case True
    { fix as pex assume "n -asι* pex" and "method_exit pex"
      with ¬ method_exit n have "as  []" 
        by(fastforce elim:path.cases simp:intra_path_def)
      with n -asι* pex inner have "hd (sourcenodes as) = n"
        by(fastforce intro:path_sourcenode simp:intra_path_def)
      from as  [] have "sourcenodes as  []" by(simp add:sourcenodes_def)
      with ‹hd (sourcenodes as) = n[THEN sym] 
      have "n  set (sourcenodes as)" by simp }
    hence "as pex. (n -asι* pex  method_exit pex)  n  set (sourcenodes as)"
      by fastforce
    with True inner show ?thesis 
      by(fastforce intro:empty_path 
                   simp:postdominate_def inner_is_valid intra_path_def)
  next
    case False
    with inner show ?thesis by(fastforce dest:inner_is_valid Exit_path)
  qed
qed



lemma postdominate_trans:
  assumes "n'' postdominates n" and "n' postdominates n''"
  shows "n' postdominates n"
proof -
  from n'' postdominates n n' postdominates n''
  have "valid_node n" and "valid_node n'" by(simp_all add:postdominate_def)
  { fix as pex assume "n -asι* pex" and "method_exit pex"
    with n'' postdominates n have "n''  set (sourcenodes as)"
      by(fastforce simp:postdominate_def)
    then obtain ns' ns'' where "sourcenodes as = ns'@n''#ns''"
      by(auto dest:split_list)
    then obtain as' as'' a where "sourcenodes as'' = ns''" and [simp]:"as=as'@a#as''"
      and [simp]:"sourcenode a = n''"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from n -asι* pex have "n -as'@a#as''ι* pex" by simp
    hence "n'' -a#as''ι* pex"
      by(fastforce dest:path_split_second simp:intra_path_def)
    with n' postdominates n'' ‹method_exit pex
    have "n'  set(sourcenodes (a#as''))" by(fastforce simp:postdominate_def)
    hence "n'  set (sourcenodes as)" by(fastforce simp:sourcenodes_def) }
  with ‹valid_node n ‹valid_node n'
  show ?thesis by(fastforce simp:postdominate_def)
qed


lemma postdominate_antisym:
  assumes "n' postdominates n" and "n postdominates n'"
  shows "n = n'"
proof -
  from n' postdominates n have "valid_node n" and "valid_node n'" 
    by(auto simp:postdominate_def)
  from ‹valid_node n obtain asx where "n -asx* (_Exit_)" by(auto dest:Exit_path)
  then obtain as' pex where "n -as'ι* pex" and "method_exit pex"
    by -(erule valid_Exit_path_intra_path)
  with n' postdominates n have "nx  set(sourcenodes as'). nx = n'"
    by(fastforce simp:postdominate_def)
  then obtain ns ns' where "sourcenodes as' = ns@n'#ns'"
    and "nx  set ns'. nx  n'"
    by(fastforce elim!:split_list_last_propE)
  from ‹sourcenodes as' = ns@n'#ns' obtain asx a asx' 
    where [simp]:"ns' = sourcenodes asx'" "as' = asx@a#asx'" "sourcenode a = n'"
    by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
  from n -as'ι* pex have "n' -a#asx'ι* pex"
    by(fastforce dest:path_split_second simp:intra_path_def)
  with n postdominates n' ‹method_exit pex have "n  set(sourcenodes (a#asx'))" 
    by(fastforce simp:postdominate_def)
  hence "n = n'  n  set(sourcenodes asx')" by(simp add:sourcenodes_def)
  thus ?thesis
  proof
    assume "n = n'" thus ?thesis .
  next
    assume "n  set(sourcenodes asx')"
    then obtain nsx' nsx'' where "sourcenodes asx' = nsx'@n#nsx''"
      by(auto dest:split_list)
    then obtain asi asi' a' where [simp]:"asx' = asi@a'#asi'" "sourcenode a' = n"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    with n -as'ι* pex have "n -(asx@a#asi)@a'#asi'ι* pex" by simp
    hence "n -(asx@a#asi)@a'#asi'→* pex"
      and "a  set ((asx@a#asi)@a'#asi'). intra_kind (kind a)"
      by(simp_all add:intra_path_def)
    from n -(asx@a#asi)@a'#asi'→* pex
    have "n -a'#asi'→* pex" by(fastforce dest:path_split_second)
    with a  set ((asx@a#asi)@a'#asi'). intra_kind (kind a)
    have "n -a'#asi'ι* pex" by(simp add:intra_path_def)
    with n' postdominates n ‹method_exit pex 
    have "n'  set(sourcenodes (a'#asi'))" by(fastforce simp:postdominate_def)
    hence "n' = n  n'  set(sourcenodes asi')"
      by(simp add:sourcenodes_def)
    thus ?thesis
    proof
      assume "n' = n" thus ?thesis by(rule sym)
    next
      assume "n'  set(sourcenodes asi')"
      with nx  set ns'. nx  n' have False by(fastforce simp:sourcenodes_def)
      thus ?thesis by simp
    qed
  qed
qed


lemma postdominate_path_branch:
  assumes "n -as→* n''" and "n' postdominates n''" and "¬ n' postdominates n"
  obtains a as' as'' where "as = as'@a#as''" and "valid_edge a"
  and "¬ n' postdominates (sourcenode a)" and "n' postdominates (targetnode a)"
proof(atomize_elim)
  from assms
  show "as' a as''. as = as'@a#as''  valid_edge a  
    ¬ n' postdominates (sourcenode a)  n' postdominates (targetnode a)"
  proof(induct rule:path.induct)
    case (Cons_path n'' as nx a n)
    note IH = n' postdominates nx; ¬ n' postdominates n''
       as' a as''. as = as'@a#as''  valid_edge a 
        ¬ n' postdominates sourcenode a  n' postdominates targetnode a
    show ?case
    proof(cases "n' postdominates n''")
      case True
      with ¬ n' postdominates n sourcenode a = n targetnode a = n''
        valid_edge a show ?thesis by blast
    next
      case False
      from IH[OF n' postdominates nx this] show ?thesis
        by clarsimp(rule_tac x="a#as'" in exI,clarsimp)
    qed
  qed simp
qed


lemma Exit_no_postdominator:
  assumes "(_Exit_) postdominates n" shows False
proof -
  from (_Exit_) postdominates n have "valid_node n" by(simp add:postdominate_def)
  from ‹valid_node n obtain asx where "n -asx* (_Exit_)" by(auto dest:Exit_path)
  then obtain as' pex where "n -as'ι* pex" and "method_exit pex"
    by -(erule valid_Exit_path_intra_path)
  with (_Exit_) postdominates n have "(_Exit_)  set (sourcenodes as')"
    by(fastforce simp:postdominate_def)
  with n -as'ι* pex show False by(fastforce simp:intra_path_def)
qed


lemma postdominate_inner_path_targetnode:
  assumes "n' postdominates n" and "n -asι* n''" and "n'  set(sourcenodes as)"
  shows "n' postdominates n''"
proof -
  from n' postdominates n obtain asx 
    where "valid_node n" and "valid_node n'"
    and all:"as pex. (n -asι* pex  method_exit pex)  n'  set (sourcenodes as)"
    by(auto simp:postdominate_def)
  from n -asι* n'' have "valid_node n''"
    by(fastforce dest:path_valid_node simp:intra_path_def)
  have "as' pex'. (n'' -as'ι* pex'  method_exit pex')  
                   n'  set (sourcenodes as')"
  proof(rule ccontr)
    assume "¬ (as' pex'. (n'' -as'ι* pex'  method_exit pex')  
                          n'  set (sourcenodes as'))"
    then obtain as' pex' where "n'' -as'ι* pex'" and "method_exit pex'"
      and "n'  set (sourcenodes as')" by blast
    from n -asι* n'' n'' -as'ι* pex' have "n -as@as'ι* pex'"
      by(fastforce intro:path_Append simp:intra_path_def)
    from n'  set(sourcenodes as) n'  set (sourcenodes as')
    have "n'  set (sourcenodes (as@as'))"
      by(simp add:sourcenodes_def)
    with n -as@as'ι* pex' ‹method_exit pex' n' postdominates n
    show False by(fastforce simp:postdominate_def)
  qed
  with ‹valid_node n' ‹valid_node n''
  show ?thesis by(auto simp:postdominate_def)
qed


lemma not_postdominate_source_not_postdominate_target:
  assumes "¬ n postdominates (sourcenode a)" 
  and "valid_node n" and "valid_edge a" and "intra_kind (kind a)"
  obtains ax where "sourcenode a = sourcenode ax" and "valid_edge ax"
  and "¬ n postdominates targetnode ax"
proof(atomize_elim)
  show "ax. sourcenode a = sourcenode ax  valid_edge ax  
    ¬ n postdominates targetnode ax"
  proof -
    from assms obtain asx pex 
      where "sourcenode a -asxι* pex" and "method_exit pex"
      and "n  set(sourcenodes asx)" by(fastforce simp:postdominate_def)
    show ?thesis
    proof(cases asx)
      case Nil
      with sourcenode a -asxι* pex have "pex = sourcenode a"
        by(fastforce simp:intra_path_def)
      with ‹method_exit pex have "method_exit (sourcenode a)" by simp
      thus ?thesis
      proof(rule method_exit_cases)
        assume "sourcenode a = (_Exit_)"
        with valid_edge a have False by(rule Exit_source)
        thus ?thesis by simp
      next
        fix a' Q f p assume "sourcenode a = sourcenode a'"
          and "valid_edge a'" and "kind a' = Qpf"
        hence False using ‹intra_kind (kind a) valid_edge a
          by(fastforce dest:return_edges_only simp:intra_kind_def)
        thus ?thesis by simp
      qed
    next
      case (Cons ax asx')
      with sourcenode a -asxι* pex
      have "sourcenode a -[]@ax#asx'→* pex" 
        and "a  set (ax#asx'). intra_kind (kind a)" by(simp_all add:intra_path_def)
      from sourcenode a -[]@ax#asx'→* pex
      have "sourcenode a = sourcenode ax" and "valid_edge ax"
        and "targetnode ax -asx'→* pex"  by(fastforce dest:path_split)+
      with a  set (ax#asx'). intra_kind (kind a)
      have "targetnode ax -asx'ι* pex" by(simp add:intra_path_def)
      with n  set(sourcenodes asx) Cons ‹method_exit pex
      have "¬ n postdominates targetnode ax"
        by(fastforce simp:postdominate_def sourcenodes_def) 
      with sourcenode a = sourcenode ax valid_edge ax show ?thesis by blast
    qed
  qed
qed


lemma inner_node_Exit_edge:
  assumes "inner_node n" 
  obtains a where "valid_edge a" and "intra_kind (kind a)" 
  and "inner_node (sourcenode a)" and "targetnode a = (_Exit_)"
proof(atomize_elim)
  from ‹inner_node n have "valid_node n" by(rule inner_is_valid)
  then obtain as where "n -as* (_Exit_)" by(fastforce dest:Exit_path)
  show "a. valid_edge a  intra_kind (kind a)  inner_node (sourcenode a)  
    targetnode a = (_Exit_)"
  proof(cases "as = []")
    case True
    with ‹inner_node n n -as* (_Exit_) have False by(fastforce simp:vp_def)
    thus ?thesis by simp
  next
    case False
    with n -as* (_Exit_) obtain a' as' where "as = as'@[a']" 
      and "n -as'* sourcenode a'" and "valid_edge a'" 
      and "(_Exit_) = targetnode a'" by -(erule vp_split_snoc)
    from valid_edge a' have "valid_node (sourcenode a')" by simp
    thus ?thesis
    proof(cases "sourcenode a'" rule:valid_node_cases)
      case Entry
      with n -as'* sourcenode a' have "n -as'→* (_Entry_)" by(simp add:vp_def)
      with ‹inner_node n
      have False by -(drule path_Entry_target,auto simp:inner_node_def)
      thus ?thesis by simp
    next
      case Exit
      from valid_edge a' this have False by(rule Exit_source)
      thus ?thesis by simp
    next
      case inner
      have "intra_kind (kind a')"
      proof(cases "kind a'" rule:edge_kind_cases)
        case Intra thus ?thesis by simp
      next
        case (Call Q r p fs)
        with valid_edge a' have "get_proc(targetnode a') = p" by(rule get_proc_call)
        with (_Exit_) = targetnode a' get_proc_Exit have "p = Main" by simp
        with kind a' = Q:rpfs have "kind a' = Q:rMainfs" by simp
        with valid_edge a' have False by(rule Main_no_call_target)
        thus ?thesis by simp
      next
        case (Return Q p f)
        from valid_edge a' kind a' = Qpf (_Exit_) = targetnode a'[THEN sym]
        have False by(rule Exit_no_return_target)
        thus ?thesis by simp
      qed
      with valid_edge a' (_Exit_) = targetnode a' ‹inner_node (sourcenode a') 
      show ?thesis by simp blast
    qed
  qed
qed


lemma inner_node_Entry_edge:
  assumes "inner_node n" 
  obtains a where "valid_edge a" and "intra_kind (kind a)" 
  and "inner_node (targetnode a)" and "sourcenode a = (_Entry_)"
proof(atomize_elim)
  from ‹inner_node n have "valid_node n" by(rule inner_is_valid)
  then obtain as where "(_Entry_) -as* n" by(fastforce dest:Entry_path)
  show "a. valid_edge a  intra_kind (kind a)  inner_node (targetnode a)  
    sourcenode a = (_Entry_)"
  proof(cases "as = []")
    case True
    with ‹inner_node n (_Entry_) -as* n have False
      by(fastforce simp:inner_node_def vp_def)
    thus ?thesis by simp
  next
    case False
    with (_Entry_) -as* n obtain a' as' where "as = a'#as'" 
      and "targetnode a' -as'* n" and "valid_edge a'" 
      and "(_Entry_) = sourcenode a'" by -(erule vp_split_Cons)
    from valid_edge a' have "valid_node (targetnode a')" by simp
    thus ?thesis
    proof(cases "targetnode a'" rule:valid_node_cases)
      case Entry
      from valid_edge a' this have False by(rule Entry_target)
      thus ?thesis by simp
    next
      case Exit
      with targetnode a' -as'* n have "(_Exit_) -as'→* n" by(simp add:vp_def)
      with ‹inner_node n
      have False by -(drule path_Exit_source,auto simp:inner_node_def)
      thus ?thesis by simp
    next
      case inner
      have "intra_kind (kind a')"
      proof(cases "kind a'" rule:edge_kind_cases)
        case Intra thus ?thesis by simp
      next
        case (Call Q r p fs)
        from valid_edge a' kind a' = Q:rpfs 
          (_Entry_) = sourcenode a'[THEN sym]
        have False by(rule Entry_no_call_source)
        thus ?thesis by simp
      next
        case (Return Q p f)
        with valid_edge a' have "get_proc(sourcenode a') = p" 
          by(rule get_proc_return)
        with (_Entry_) = sourcenode a' get_proc_Entry have "p = Main" by simp
        with kind a' = Qpf have "kind a' = QMainf" by simp
        with valid_edge a' have False by(rule Main_no_return_source)
        thus ?thesis by simp
      qed
      with valid_edge a' (_Entry_) = sourcenode a' ‹inner_node (targetnode a') 
      show ?thesis by simp blast
    qed
  qed
qed


lemma intra_path_to_matching_method_exit:
  assumes "method_exit n'" and "get_proc n = get_proc n'" and "valid_node n"
  obtains as where "n -asι* n'"
proof(atomize_elim)
  from ‹valid_node n obtain as' where "n -as'* (_Exit_)"
    by(fastforce dest:Exit_path)
  then obtain as mex where "n -asι* mex" and "method_exit mex"
    by(fastforce elim:valid_Exit_path_intra_path)
  from n -asι* mex have "get_proc n = get_proc mex" 
    by(rule intra_path_get_procs)
  with ‹method_exit n' get_proc n = get_proc n' ‹method_exit mex
  have "mex = n'" by(fastforce intro:method_exit_unique)
  with n -asι* mex show "as. n -asι* n'" by fastforce
qed


end

end

Theory SDG

section ‹SDG›

theory SDG imports CFGExit_wf Postdomination begin

subsection ‹The nodes of the SDG›

datatype 'node SDG_node = 
    CFG_node 'node
  | Formal_in  "'node × nat"
  | Formal_out "'node × nat"
  | Actual_in  "'node × nat"
  | Actual_out "'node × nat"

fun parent_node :: "'node SDG_node  'node"
  where "parent_node (CFG_node n) = n"
  | "parent_node (Formal_in (m,x)) = m"
  | "parent_node (Formal_out (m,x)) = m"
  | "parent_node (Actual_in (m,x)) = m"
  | "parent_node (Actual_out (m,x)) = m"


locale SDG = CFGExit_wf sourcenode targetnode kind valid_edge Entry 
    get_proc get_return_edges procs Main Exit Def Use ParamDefs ParamUses +
  Postdomination sourcenode targetnode kind valid_edge Entry 
    get_proc get_return_edges procs Main Exit
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  ('var,'val,'ret,'pname) edge_kind" 
  and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')")  and get_proc :: "'node  'pname"
  and get_return_edges :: "'edge  'edge set"
  and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname"
  and Exit::"'node"  ("'('_Exit'_')") 
  and Def :: "'node  'var set" and Use :: "'node  'var set"
  and ParamDefs :: "'node  'var list" and ParamUses :: "'node  'var set list"

begin


fun valid_SDG_node :: "'node SDG_node  bool"
  where "valid_SDG_node (CFG_node n)  valid_node n"
  | "valid_SDG_node (Formal_in (m,x)) 
  (a Q r p fs ins outs. valid_edge a  (kind a = Q:rpfs)  targetnode a = m  
  (p,ins,outs)  set procs  x < length ins)"
  | "valid_SDG_node (Formal_out (m,x)) 
  (a Q p f ins outs. valid_edge a  (kind a = Qpf)  sourcenode a = m  
  (p,ins,outs)  set procs  x < length outs)"
  | "valid_SDG_node (Actual_in (m,x)) 
  (a Q r p fs ins outs. valid_edge a  (kind a = Q:rpfs)  sourcenode a = m  
  (p,ins,outs)  set procs  x < length ins)"
  | "valid_SDG_node (Actual_out (m,x)) 
  (a Q p f ins outs. valid_edge a  (kind a = Qpf)  targetnode a = m  
  (p,ins,outs)  set procs  x < length outs)"


lemma valid_SDG_CFG_node: 
  "valid_SDG_node n  valid_node (parent_node n)"
by(cases n) auto


lemma Formal_in_parent_det:
  assumes "valid_SDG_node (Formal_in (m,x))" and "valid_SDG_node (Formal_in (m',x'))"
  and "get_proc m = get_proc m'"
  shows "m = m'"
proof -
  from ‹valid_SDG_node (Formal_in (m,x)) obtain a Q r p fs ins outs
    where "valid_edge a" and "kind a = Q:rpfs" and "targetnode a = m"
    and "(p,ins,outs)  set procs" and "x < length ins" by fastforce
  from ‹valid_SDG_node (Formal_in (m',x')) obtain a' Q' r' p' f' ins' outs'
    where "valid_edge a'" and "kind a' = Q':r'p'f'" and "targetnode a' = m'"
    and "(p',ins',outs')  set procs" and "x' < length ins'" by fastforce
  from valid_edge a kind a = Q:rpfs targetnode a = m
  have "get_proc m = p" by(fastforce intro:get_proc_call)
  moreover
  from valid_edge a' kind a' = Q':r'p'f' targetnode a' = m'
  have "get_proc m' = p'" by(fastforce intro:get_proc_call)
  ultimately have "p = p'" using get_proc m = get_proc m' by simp
  with valid_edge a kind a = Q:rpfs valid_edge a' kind a' = Q':r'p'f'
    targetnode a = m targetnode a' = m'
  show ?thesis by(fastforce intro:same_proc_call_unique_target)
qed


lemma valid_SDG_node_parent_Entry:
  assumes "valid_SDG_node n" and "parent_node n = (_Entry_)"
  shows "n = CFG_node (_Entry_)"
proof(cases n)
  case CFG_node with ‹parent_node n = (_Entry_) show ?thesis by simp
next
  case (Formal_in z)
  with ‹parent_node n = (_Entry_) obtain x 
    where [simp]:"z = ((_Entry_),x)" by(cases z) auto
  with ‹valid_SDG_node n Formal_in obtain a where "valid_edge a"
    and "targetnode a = (_Entry_)" by auto
  hence False by -(rule Entry_target,simp+)
  thus ?thesis by simp
next
  case (Formal_out z)
  with ‹parent_node n = (_Entry_) obtain x 
    where [simp]:"z = ((_Entry_),x)" by(cases z) auto
  with ‹valid_SDG_node n Formal_out obtain a Q p f where "valid_edge a"
    and "kind a = Qpf" and  "sourcenode a = (_Entry_)" by auto
  from valid_edge a kind a = Qpf have "get_proc (sourcenode a) = p"
    by(rule get_proc_return)
  with sourcenode a = (_Entry_) have "p = Main"
    by(auto simp:get_proc_Entry)
  with valid_edge a kind a = Qpf have False
    by(fastforce intro:Main_no_return_source)
  thus ?thesis by simp
next
  case (Actual_in z)
  with ‹parent_node n = (_Entry_) obtain x 
    where [simp]:"z = ((_Entry_),x)" by(cases z) auto
  with ‹valid_SDG_node n Actual_in obtain a Q r p fs where "valid_edge a"
    and "kind a = Q:rpfs" and "sourcenode a = (_Entry_)" by fastforce
  hence False by -(rule Entry_no_call_source,auto)
  thus ?thesis by simp
next
  case (Actual_out z)
  with ‹parent_node n = (_Entry_) obtain x 
    where [simp]:"z = ((_Entry_),x)" by(cases z) auto
  with ‹valid_SDG_node n Actual_out obtain a where "valid_edge a"
    "targetnode a = (_Entry_)" by auto
  hence False by -(rule Entry_target,simp+)
  thus ?thesis by simp
qed


lemma valid_SDG_node_parent_Exit:
  assumes "valid_SDG_node n" and "parent_node n = (_Exit_)"
  shows "n = CFG_node (_Exit_)"
proof(cases n)
  case CFG_node with ‹parent_node n = (_Exit_) show ?thesis by simp
next
  case (Formal_in z)
  with ‹parent_node n = (_Exit_) obtain x 
    where [simp]:"z = ((_Exit_),x)" by(cases z) auto
  with ‹valid_SDG_node n Formal_in obtain a Q r p fs where "valid_edge a"
    and "kind a = Q:rpfs" and "targetnode a = (_Exit_)" by fastforce
  from valid_edge a kind a = Q:rpfs have "get_proc (targetnode a) = p"
    by(rule get_proc_call)
  with targetnode a = (_Exit_) have "p = Main"
    by(auto simp:get_proc_Exit)
  with valid_edge a kind a = Q:rpfs have False
    by(fastforce intro:Main_no_call_target)
  thus ?thesis by simp
next
  case (Formal_out z)
  with ‹parent_node n = (_Exit_) obtain x 
    where [simp]:"z = ((_Exit_),x)" by(cases z) auto
  with ‹valid_SDG_node n Formal_out obtain a where "valid_edge a"
    and "sourcenode a = (_Exit_)" by auto
  hence False by -(rule Exit_source,simp+)
  thus ?thesis by simp
next
  case (Actual_in z)
  with ‹parent_node n = (_Exit_) obtain x 
    where [simp]:"z = ((_Exit_),x)" by(cases z) auto
  with ‹valid_SDG_node n Actual_in obtain a where "valid_edge a"
    and "sourcenode a = (_Exit_)" by auto
  hence False by -(rule Exit_source,simp+)
  thus ?thesis by simp
next
  case (Actual_out z)
  with ‹parent_node n = (_Exit_) obtain x 
    where [simp]:"z = ((_Exit_),x)" by(cases z) auto
  with ‹valid_SDG_node n Actual_out obtain a Q p f where "valid_edge a"
    and "kind a = Qpf" and "targetnode a = (_Exit_)" by auto
  hence False by -(erule Exit_no_return_target,auto)
  thus ?thesis by simp
qed


subsection ‹Data dependence›

inductive SDG_Use :: "'var  'node SDG_node  bool" ("_  UseSDG _")
where CFG_Use_SDG_Use:
  "valid_node m; V  Use m; n = CFG_node m  V  UseSDG n"
  | Actual_in_SDG_Use:
  "valid_SDG_node n; n = Actual_in (m,x); V  (ParamUses m)!x  V  UseSDG n"
  | Formal_out_SDG_Use:
  "valid_SDG_node n; n = Formal_out (m,x); get_proc m = p; (p,ins,outs)  set procs;
    V = outs!x  V  UseSDG n"


abbreviation notin_SDG_Use :: "'var  'node SDG_node  bool"  ("_  UseSDG _")
  where "V  UseSDG n  ¬ V  UseSDG n"


lemma in_Use_valid_SDG_node:
  "V  UseSDG n  valid_SDG_node n"
by(induct rule:SDG_Use.induct,auto intro:valid_SDG_CFG_node)


lemma SDG_Use_parent_Use: 
  "V  UseSDG n  V  Use (parent_node n)"
proof(induct rule:SDG_Use.induct)
  case CFG_Use_SDG_Use thus ?case by simp
next
  case (Actual_in_SDG_Use n m x V)
  from ‹valid_SDG_node n n = Actual_in (m, x) obtain a Q r p fs ins outs
    where "valid_edge a" and "kind a = Q:rpfs" and "sourcenode a = m"
    and "(p,ins,outs)  set procs" and "x < length ins" by fastforce
  from valid_edge a kind a = Q:rpfs (p,ins,outs)  set procs
  have "length(ParamUses (sourcenode a)) = length ins"
    by(fastforce intro:ParamUses_call_source_length)
  with x < length ins
  have "(ParamUses (sourcenode a))!x  set (ParamUses (sourcenode a))" by simp
  with V  (ParamUses m)!x sourcenode a = m
  have "V  Union (set (ParamUses m))" by fastforce
  with valid_edge a sourcenode a = m n = Actual_in (m, x) show ?case
    by(fastforce intro:ParamUses_in_Use)
next
  case (Formal_out_SDG_Use n m x p ins outs V)
  from ‹valid_SDG_node n n = Formal_out (m, x) obtain a Q p' f ins' outs'
    where "valid_edge a" and "kind a = Qp'f" and "sourcenode a = m"
    and "(p',ins',outs')  set procs" and "x < length outs'" by fastforce
  from valid_edge a kind a = Qp'f have "get_proc (sourcenode a) = p'"
    by(rule get_proc_return)
  with get_proc m = p sourcenode a = m have [simp]:"p = p'" by simp
  with (p',ins',outs')  set procs (p,ins,outs)  set procs unique_callers
  have [simp]:"ins' = ins" "outs' = outs" by(auto dest:distinct_fst_isin_same_fst)
  from x < length outs' V = outs ! x have "V  set outs" by fastforce
  with valid_edge a kind a = Qp'f (p,ins,outs)  set procs
  have "V  Use (sourcenode a)" by(fastforce intro:outs_in_Use)
  with sourcenode a = m ‹valid_SDG_node n n = Formal_out (m, x)
  show ?case by simp
qed



inductive SDG_Def :: "'var  'node SDG_node  bool" ("_  DefSDG _")
where CFG_Def_SDG_Def:
  "valid_node m; V  Def m; n = CFG_node m  V  DefSDG n"
  | Formal_in_SDG_Def:
  "valid_SDG_node n; n = Formal_in (m,x); get_proc m = p; (p,ins,outs)  set procs;
    V = ins!x  V  DefSDG n"
  | Actual_out_SDG_Def:
  "valid_SDG_node n; n = Actual_out (m,x); V = (ParamDefs m)!x  V  DefSDG n"

abbreviation notin_SDG_Def :: "'var  'node SDG_node  bool"  ("_  DefSDG _")
  where "V  DefSDG n  ¬ V  DefSDG n"


lemma in_Def_valid_SDG_node:
  "V  DefSDG n  valid_SDG_node n"
by(induct rule:SDG_Def.induct,auto intro:valid_SDG_CFG_node)


lemma SDG_Def_parent_Def: 
  "V  DefSDG n  V  Def (parent_node n)"
proof(induct rule:SDG_Def.induct)
  case CFG_Def_SDG_Def thus ?case by simp
next
  case (Formal_in_SDG_Def n m x p ins outs V)
  from ‹valid_SDG_node n n = Formal_in (m, x) obtain a Q r p' fs ins' outs'
    where "valid_edge a" and "kind a = Q:rp'fs" and "targetnode a = m"
    and "(p',ins',outs')  set procs" and "x < length ins'" by fastforce
  from valid_edge a kind a = Q:rp'fs have "get_proc (targetnode a) = p'"
    by(rule get_proc_call)
  with get_proc m = p targetnode a = m have [simp]:"p = p'" by simp
  with (p',ins',outs')  set procs (p,ins,outs)  set procs unique_callers
  have [simp]:"ins' = ins" "outs' = outs" by(auto dest:distinct_fst_isin_same_fst)
  from x < length ins' V = ins ! x have "V  set ins" by fastforce
  with valid_edge a kind a = Q:rp'fs (p,ins,outs)  set procs
  have "V  Def (targetnode a)" by(fastforce intro:ins_in_Def)
  with targetnode a = m ‹valid_SDG_node n n = Formal_in (m, x)
  show ?case by simp
next
  case (Actual_out_SDG_Def n m x V)
  from ‹valid_SDG_node n n = Actual_out (m, x) obtain a Q p f ins outs
    where "valid_edge a" and "kind a = Qpf" and "targetnode a = m"
    and "(p,ins,outs)  set procs" and "x < length outs" by fastforce
  from valid_edge a kind a = Qpf (p,ins,outs)  set procs
  have "length(ParamDefs (targetnode a)) = length outs" 
    by(rule ParamDefs_return_target_length)
  with x < length outs V = ParamDefs m ! x targetnode a = m
  have "V  set (ParamDefs (targetnode a))" by(fastforce simp:set_conv_nth)
  with n = Actual_out (m, x) targetnode a = m valid_edge a
  show ?case by(fastforce intro:ParamDefs_in_Def)
qed



definition data_dependence :: "'node SDG_node  'var  'node SDG_node  bool" 
("_ influences _ in _" [51,0,0])
  where "n influences V in n'  as. (V  DefSDG n)  (V  UseSDG n')  
  (parent_node n -asι* parent_node n') 
  (n''. valid_SDG_node n''  parent_node n''  set (sourcenodes (tl as))
          V  DefSDG n'')"


subsection ‹Control dependence›

definition control_dependence :: "'node  'node  bool" 
  ("_ controls _" [51,0])
where "n controls n'  a a' as. n -a#asι* n'  n'  set(sourcenodes (a#as)) 
    intra_kind(kind a)  n' postdominates (targetnode a)  
    valid_edge a'  intra_kind(kind a')  sourcenode a' = n  
    ¬ n' postdominates (targetnode a')"


lemma control_dependence_path:
  assumes "n controls n'" obtains as where "n -asι* n'" and "as  []"
using n controls n'
by(fastforce simp:control_dependence_def)


lemma Exit_does_not_control [dest]:
  assumes "(_Exit_) controls n'" shows "False"
proof -
  from (_Exit_) controls n' obtain a where "valid_edge a"
    and "sourcenode a = (_Exit_)" by(auto simp:control_dependence_def)
  thus ?thesis by(rule Exit_source)
qed


lemma Exit_not_control_dependent: 
  assumes "n controls n'" shows "n'  (_Exit_)"
proof -
  from n controls n' obtain a as where "n -a#asι* n'"
    and "n' postdominates (targetnode a)"
    by(auto simp:control_dependence_def)
  from n -a#asι* n' have "valid_edge a" 
    by(fastforce elim:path.cases simp:intra_path_def)
  hence "valid_node (targetnode a)" by simp
  with n' postdominates (targetnode a) n -a#asι* n' show ?thesis
    by(fastforce elim:Exit_no_postdominator)
qed


lemma which_node_intra_standard_control_dependence_source:
  assumes "nx -as@a#as'ι* n" and "sourcenode a = n'" and "sourcenode a' = n'"
  and "n  set(sourcenodes (a#as'))" and "valid_edge a'" and "intra_kind(kind a')"
  and "inner_node n" and "¬ method_exit n" and "¬ n postdominates (targetnode a')"
  and last:"ax ax'. ax  set as'  sourcenode ax = sourcenode ax' 
    valid_edge ax'  intra_kind(kind ax')  n postdominates targetnode ax'"
  shows "n' controls n"
proof -
  from nx -as@a#as'ι* n sourcenode a = n' have "n' -a#as'ι* n"
    by(fastforce dest:path_split_second simp:intra_path_def)
  from nx -as@a#as'ι* n have "valid_edge a"
    by(fastforce intro:path_split simp:intra_path_def)
  show ?thesis
  proof(cases "n postdominates (targetnode a)")
    case True
    with n' -a#as'ι* n n  set(sourcenodes (a#as'))
      valid_edge a' ‹intra_kind(kind a') sourcenode a' = n' 
      ¬ n postdominates (targetnode a') show ?thesis
      by(fastforce simp:control_dependence_def intra_path_def)
  next
    case False
    show ?thesis
    proof(cases "as' = []")
      case True
      with n' -a#as'ι* n have "targetnode a = n" 
        by(fastforce elim:path.cases simp:intra_path_def)
      with ‹inner_node n ¬ method_exit n have "n postdominates (targetnode a)"
        by(fastforce dest:inner_is_valid intro:postdominate_refl)
      with ¬ n postdominates (targetnode a) show ?thesis by simp
    next
      case False
      with nx -as@a#as'ι* n have "targetnode a -as'ι* n"
        by(fastforce intro:path_split simp:intra_path_def)
     with ¬ n postdominates (targetnode a) valid_edge a ‹inner_node n
        targetnode a -as'ι* n
      obtain asx pex where "targetnode a -asxι* pex" and "method_exit pex"
        and "n  set (sourcenodes asx)"
        by(fastforce dest:inner_is_valid simp:postdominate_def)
      show ?thesis
      proof(cases "asx'. asx = as'@asx'")
        case True
        then obtain asx' where [simp]:"asx = as'@asx'" by blast
        from targetnode a -asxι* pex targetnode a -as'ι* n
          as'  [] ‹method_exit pex ¬ method_exit n
        obtain a'' as'' where "asx' = a''#as''  sourcenode a'' = n"
          by(cases asx')(auto dest:path_split path_det simp:intra_path_def)
        hence "n  set(sourcenodes asx)" by(simp add:sourcenodes_def)
        with n  set (sourcenodes asx) have False by simp
        thus ?thesis by simp
      next
        case False
        hence "asx'. asx  as'@asx'" by simp
        then obtain j asx' where "asx = (take j as')@asx'"
          and "j < length as'" and "k > j. asx''. asx  (take k as')@asx''"
          by(auto elim:path_split_general)
        from asx = (take j as')@asx' j < length as'
        have "as'1 as'2. asx = as'1@asx'  
          as' = as'1@as'2  as'2  []  as'1 = take j as'"
          by simp(rule_tac x= "drop j as'" in exI,simp)
        then obtain as'1 as'' where "asx = as'1@asx'"
          and "as'1 = take j as'"
          and "as' = as'1@as''" and "as''  []" by blast
        from as' = as'1@as'' as''  [] obtain a1 as'2 
          where "as' = as'1@a1#as'2" and "as'' = a1#as'2"
          by(cases as'') auto
        have "asx'  []"
        proof(cases "asx' = []")
          case True
          with asx = as'1@asx' as' = as'1@as'' as'' = a1#as'2
          have "as' = asx@a1#as'2" by simp
          with n' -a#as'ι* n have "n' -(a#asx)@a1#as'2ι* n" by simp
          hence "n' -(a#asx)@a1#as'2→* n" 
            and "ax  set((a#asx)@a1#as'2). intra_kind(kind ax)"
            by(simp_all add:intra_path_def)
          from n' -(a#asx)@a1#as'2→* n
          have "n' -a#asx→* sourcenode a1" and "valid_edge a1"
            by -(erule path_split)+
          from ax  set((a#asx)@a1#as'2). intra_kind(kind ax) 
          have "ax  set(a#asx). intra_kind(kind ax)" by simp
          with n' -a#asx→* sourcenode a1 have "n' -a#asxι* sourcenode a1"
            by(simp add:intra_path_def)
          hence "targetnode a -asxι* sourcenode a1"
            by(fastforce intro:path_split_Cons simp:intra_path_def)
          with targetnode a -asxι* pex have "pex = sourcenode a1"
            by(fastforce intro:path_det simp:intra_path_def)
          from ax  set((a#asx)@a1#as'2). intra_kind(kind ax)
          have "intra_kind (kind a1)" by simp
          from ‹method_exit pex have False
          proof(rule method_exit_cases)
            assume "pex = (_Exit_)"
            with pex = sourcenode a1 have "sourcenode a1 = (_Exit_)" by simp
            with valid_edge a1 show False by(rule Exit_source)
          next
            fix a Q f p assume "pex = sourcenode a" and "valid_edge a"
              and "kind a = Qpf"
            from valid_edge a kind a = Qpf pex = sourcenode a 
              pex = sourcenode a1 valid_edge a1 ‹intra_kind (kind a1)
            show False by(fastforce dest:return_edges_only simp:intra_kind_def)
          qed
          thus ?thesis by simp
        qed simp
        with asx = as'1@asx' obtain a2 asx'1 
          where "asx = as'1@a2#asx'1"
          and "asx' = a2#asx'1" by(cases asx') auto
        from n' -a#as'ι* n as' = as'1@a1#as'2 
        have "n' -(a#as'1)@a1#as'2ι* n" by simp
        hence "n' -(a#as'1)@a1#as'2→* n" 
          and "ax  set((a#as'1)@a1#as'2). intra_kind(kind ax)"
          by(simp_all add: intra_path_def)
        from n' -(a#as'1)@a1#as'2→* n have "n' -a#as'1→* sourcenode a1"
          and "valid_edge a1" by -(erule path_split)+
        from ax  set((a#as'1)@a1#as'2). intra_kind(kind ax)
        have "ax  set(a#as'1). intra_kind(kind ax)" by simp
        with n' -a#as'1→* sourcenode a1 have "n' -a#as'1ι* sourcenode a1"
          by(simp add:intra_path_def)
        hence "targetnode a -as'1ι* sourcenode a1"
          by(fastforce intro:path_split_Cons simp:intra_path_def)
        from targetnode a -asxι* pex asx = as'1@a2#asx'1
        have "targetnode a -as'1@a2#asx'1→* pex" by(simp add:intra_path_def)
        hence "targetnode a -as'1→* sourcenode a2" and "valid_edge a2"
          and "targetnode a2 -asx'1→* pex" by(auto intro:path_split)
        from targetnode a2 -asx'1→* pex asx = as'1@a2#asx'1
          targetnode a -asxι* pex
        have "targetnode a2 -asx'1ι* pex" by(simp add:intra_path_def)
        from targetnode a -as'1→* sourcenode a2 
          targetnode a -as'1ι* sourcenode a1 
        have "sourcenode a1 = sourcenode a2"
          by(fastforce intro:path_det simp:intra_path_def)
        from asx = as'1@a2#asx'1 n  set (sourcenodes asx)
        have "n  set (sourcenodes asx'1)" by(simp add:sourcenodes_def)
        with targetnode a2 -asx'1ι* pex ‹method_exit pex
          asx = as'1@a2#asx'1
        have "¬ n postdominates targetnode a2" by(fastforce simp:postdominate_def)
        from asx = as'1@a2#asx'1 targetnode a -asxι* pex
        have "intra_kind (kind a2)" by(simp add:intra_path_def)
        from as' = as'1@a1#as'2 have "a1  set as'" by simp
        with sourcenode a1 = sourcenode a2 last valid_edge a2 
          ‹intra_kind (kind a2)
        have "n postdominates targetnode a2" by blast
        with ¬ n postdominates targetnode a2 have False by simp
        thus ?thesis by simp
      qed
    qed
  qed
qed



subsection ‹SDG without summary edges›


inductive cdep_edge :: "'node SDG_node  'node SDG_node  bool" 
    ("_ cd _" [51,0] 80)
  and ddep_edge :: "'node SDG_node  'var  'node SDG_node  bool"
    ("_ -_dd _" [51,0,0] 80)
  and call_edge :: "'node SDG_node  'pname  'node SDG_node  bool" 
    ("_ -_call _" [51,0,0] 80)
  and return_edge :: "'node SDG_node  'pname  'node SDG_node  bool" 
    ("_ -_ret _" [51,0,0] 80)
  and param_in_edge :: "'node SDG_node  'pname  'var  'node SDG_node  bool"
    ("_ -_:_in _" [51,0,0,0] 80)
  and param_out_edge :: "'node SDG_node  'pname  'var  'node SDG_node  bool"
    ("_ -_:_out _" [51,0,0,0] 80)
  and SDG_edge :: "'node SDG_node  'var option  
                          ('pname × bool) option  'node SDG_node  bool"

where
    (* Syntax *)
  "ncd n' == SDG_edge n None None n'"
  | "n -Vdd n' == SDG_edge n (Some V) None n'"
  | "n -pcall n' == SDG_edge n None (Some(p,True)) n'"
  | "n -pret n' == SDG_edge n None (Some(p,False)) n'"
  | "n -p:Vin n' == SDG_edge n (Some V) (Some(p,True)) n'"
  | "n -p:Vout n' == SDG_edge n (Some V) (Some(p,False)) n'"

    (* Rules *)
  | SDG_cdep_edge:
    "n = CFG_node m; n' = CFG_node m'; m controls m'  ncd n'"
  | SDG_proc_entry_exit_cdep:
    "valid_edge a; kind a = Q:rpfs; n = CFG_node (targetnode a);
      a'  get_return_edges a; n' = CFG_node (sourcenode a')  ncd n'"
  | SDG_parent_cdep_edge:
    "valid_SDG_node n'; m = parent_node n'; n = CFG_node m; n  n' 
       ncd n'"
  | SDG_ddep_edge:"n influences V in n'  n -Vdd n'"
  | SDG_call_edge:
    "valid_edge a; kind a = Q:rpfs; n = CFG_node (sourcenode a); 
      n' = CFG_node (targetnode a)  n -pcall n'"
  | SDG_return_edge:
    "valid_edge a; kind a = Qpf; n = CFG_node (sourcenode a); 
      n' = CFG_node (targetnode a)  n -pret n'"
  | SDG_param_in_edge:
    "valid_edge a; kind a = Q:rpfs; (p,ins,outs)  set procs; V = ins!x;
      x < length ins; n = Actual_in (sourcenode a,x); n' = Formal_in (targetnode a,x)
       n -p:Vin n'"
  | SDG_param_out_edge:
    "valid_edge a; kind a = Qpf; (p,ins,outs)  set procs; V = outs!x;
      x < length outs; n = Formal_out (sourcenode a,x); 
      n' = Actual_out (targetnode a,x)
       n -p:Vout n'"


lemma cdep_edge_cases:
  "ncd n'; (parent_node n) controls (parent_node n')  P;
    a Q r p fs a'. valid_edge a; kind a = Q:rpfs; a'  get_return_edges a;
                  parent_node n = targetnode a; parent_node n' = sourcenode a'  P;
    m. n = CFG_node m; m = parent_node n'; n  n'  P  P"
by -(erule SDG_edge.cases,auto)


lemma SDG_edge_valid_SDG_node:
  assumes "SDG_edge n Vopt popt n'" 
  shows "valid_SDG_node n" and "valid_SDG_node n'"
using ‹SDG_edge n Vopt popt n'
proof(induct rule:SDG_edge.induct)
  case (SDG_cdep_edge n m n' m') 
  thus "valid_SDG_node n" "valid_SDG_node n'"
    by(fastforce elim:control_dependence_path elim:path_valid_node 
                simp:intra_path_def)+
next
  case (SDG_proc_entry_exit_cdep a Q r p f n a' n') case 1
  from valid_edge a n = CFG_node (targetnode a) show ?case by simp
next
  case (SDG_proc_entry_exit_cdep a Q r p f n a' n') case 2
  from valid_edge a a'  get_return_edges a have "valid_edge a'" 
    by(rule get_return_edges_valid)
  with n' = CFG_node (sourcenode a') show ?case by simp
next
  case (SDG_ddep_edge n V n')
  thus "valid_SDG_node n" "valid_SDG_node n'" 
    by(auto intro:in_Use_valid_SDG_node in_Def_valid_SDG_node
             simp:data_dependence_def)
qed(fastforce intro:valid_SDG_CFG_node)+


lemma valid_SDG_node_cases: 
  assumes "valid_SDG_node n"
  shows "n = CFG_node (parent_node n)  CFG_node (parent_node n)cd n"
proof(cases n)
  case (CFG_node m) thus ?thesis by simp
next
  case (Formal_in z)
  from n = Formal_in z obtain m x where "z = (m,x)" by(cases z) auto
  with ‹valid_SDG_node n n = Formal_in z have "CFG_node (parent_node n)cd n"
    by -(rule SDG_parent_cdep_edge,auto)
  thus ?thesis by fastforce
next
  case (Formal_out z)
  from n = Formal_out z obtain m x where "z = (m,x)" by(cases z) auto
  with ‹valid_SDG_node n n = Formal_out z have "CFG_node (parent_node n)cd n"
    by -(rule SDG_parent_cdep_edge,auto)
  thus ?thesis by fastforce
next
  case (Actual_in z)
  from n = Actual_in z obtain m x where "z = (m,x)" by(cases z) auto
  with ‹valid_SDG_node n n = Actual_in z have "CFG_node (parent_node n)cd n"
    by -(rule SDG_parent_cdep_edge,auto)
  thus ?thesis by fastforce
next
  case (Actual_out z)
  from n = Actual_out z obtain m x where "z = (m,x)" by(cases z) auto
  with ‹valid_SDG_node n n = Actual_out z have "CFG_node (parent_node n)cd n"
    by -(rule SDG_parent_cdep_edge,auto)
  thus ?thesis by fastforce
qed


lemma SDG_cdep_edge_CFG_node: "ncd n'  m. n = CFG_node m"
by(induct n Vopt"None::'var option" popt"None::('pname × bool) option" n' 
   rule:SDG_edge.induct) auto

lemma SDG_call_edge_CFG_node: "n -pcall n'  m. n = CFG_node m"
by(induct n Vopt"None::'var option" popt"Some(p,True)" n' 
   rule:SDG_edge.induct) auto

lemma SDG_return_edge_CFG_node: "n -pret n'  m. n = CFG_node m"
by(induct n Vopt"None::'var option" popt"Some(p,False)" n' 
   rule:SDG_edge.induct) auto



lemma SDG_call_or_param_in_edge_unique_CFG_call_edge:
  "SDG_edge n Vopt (Some(p,True)) n'
   ∃!a. valid_edge a  sourcenode a = parent_node n  
          targetnode a = parent_node n'  (Q r fs. kind a = Q:rpfs)"
proof(induct n Vopt "Some(p,True)" n' rule:SDG_edge.induct)
  case (SDG_call_edge a Q r fs n n')
  { fix a' 
    assume "valid_edge a'" and "sourcenode a' = parent_node n"
      and "targetnode a' = parent_node n'"
    from sourcenode a' = parent_node n n = CFG_node (sourcenode a)
    have "sourcenode a' = sourcenode a" by fastforce
    moreover from targetnode a' = parent_node n' n' = CFG_node (targetnode a)
    have "targetnode a' = targetnode a" by fastforce
    ultimately have "a' = a" using valid_edge a' valid_edge a
      by(fastforce intro:edge_det) }
  with valid_edge a n = CFG_node (sourcenode a) n' = CFG_node (targetnode a)
    kind a = Q:rpfs show ?case by(fastforce intro!:ex1I[of _ a])
next
  case (SDG_param_in_edge a Q r fs ins outs V x n n')
  { fix a' 
    assume "valid_edge a'" and "sourcenode a' = parent_node n"
      and "targetnode a' = parent_node n'"
    from sourcenode a' = parent_node n n = Actual_in (sourcenode a,x)
    have "sourcenode a' = sourcenode a" by fastforce
    moreover from targetnode a' = parent_node n' n' = Formal_in (targetnode a,x)
    have "targetnode a' = targetnode a" by fastforce
    ultimately have "a' = a" using valid_edge a' valid_edge a
      by(fastforce intro:edge_det) }
  with valid_edge a n = Actual_in (sourcenode a,x) 
    n' = Formal_in (targetnode a,x) kind a = Q:rpfs
  show ?case by(fastforce intro!:ex1I[of _ a])
qed simp_all


lemma SDG_return_or_param_out_edge_unique_CFG_return_edge:
  "SDG_edge n Vopt (Some(p,False)) n'
   ∃!a. valid_edge a  sourcenode a = parent_node n  
          targetnode a = parent_node n'  (Q f. kind a = Qpf)"
proof(induct n Vopt "Some(p,False)" n' rule:SDG_edge.induct)
  case (SDG_return_edge a Q f n n')
  { fix a' 
    assume "valid_edge a'" and "sourcenode a' = parent_node n" 
      and "targetnode a' = parent_node n'"
    from sourcenode a' = parent_node n n = CFG_node (sourcenode a)
    have "sourcenode a' = sourcenode a" by fastforce
    moreover from targetnode a' = parent_node n' n' = CFG_node (targetnode a)
    have "targetnode a' = targetnode a" by fastforce
    ultimately have "a' = a" using valid_edge a' valid_edge a
      by(fastforce intro:edge_det) }
  with valid_edge a n = CFG_node (sourcenode a) n' = CFG_node (targetnode a)
    kind a = Qpf show ?case by(fastforce intro!:ex1I[of _ a])
next
  case (SDG_param_out_edge a Q f ins outs V x n n')
  { fix a' 
    assume "valid_edge a'" and "sourcenode a' = parent_node n"
      and "targetnode a' = parent_node n'"
    from sourcenode a' = parent_node n n = Formal_out (sourcenode a,x)
    have "sourcenode a' = sourcenode a" by fastforce
    moreover from targetnode a' = parent_node n' n' = Actual_out (targetnode a,x)
    have "targetnode a' = targetnode a" by fastforce
    ultimately have "a' = a" using valid_edge a' valid_edge a
      by(fastforce intro:edge_det) }
  with valid_edge a n = Formal_out (sourcenode a,x)
    n' = Actual_out (targetnode a,x) kind a = Qpf
  show ?case by(fastforce intro!:ex1I[of _ a])
qed simp_all


lemma Exit_no_SDG_edge_source:
  "SDG_edge (CFG_node (_Exit_)) Vopt popt n'  False"
proof(induct "CFG_node (_Exit_)" Vopt popt n' rule:SDG_edge.induct)
  case (SDG_cdep_edge m n' m')
  hence "(_Exit_) controls m'" by simp
  thus ?case by fastforce
next
  case (SDG_proc_entry_exit_cdep a Q r p fs a' n')
  from ‹CFG_node (_Exit_) = CFG_node (targetnode a)
  have "targetnode a = (_Exit_)" by simp
  from valid_edge a kind a = Q:rpfs have "get_proc (targetnode a) = p"
    by(rule get_proc_call)
  with targetnode a = (_Exit_) have "p = Main"
    by(auto simp:get_proc_Exit)
  with valid_edge a kind a = Q:rpfs have False
    by(fastforce intro:Main_no_call_target)
  thus ?thesis by simp
next
  case (SDG_parent_cdep_edge n' m)
  from ‹CFG_node (_Exit_) = CFG_node m 
  have [simp]:"m = (_Exit_)" by simp
  with ‹valid_SDG_node n' m = parent_node n' ‹CFG_node (_Exit_)  n'
  have False by -(drule valid_SDG_node_parent_Exit,simp+)
  thus ?thesis by simp
next
  case (SDG_ddep_edge V n')
  hence "(CFG_node (_Exit_)) influences V in n'" by simp
  with Exit_empty show ?case
    by(fastforce dest:path_Exit_source SDG_Def_parent_Def 
                simp:data_dependence_def intra_path_def)
next
  case (SDG_call_edge a Q r p fs n')
  from ‹CFG_node (_Exit_) = CFG_node (sourcenode a)
  have "sourcenode a = (_Exit_)" by simp
  with valid_edge a show ?case by(rule Exit_source)
next
  case (SDG_return_edge a Q p f n')
  from ‹CFG_node (_Exit_) = CFG_node (sourcenode a)
  have "sourcenode a = (_Exit_)" by simp
  with valid_edge a show ?case by(rule Exit_source)
qed simp_all


subsection ‹Intraprocedural paths in the SDG›

inductive intra_SDG_path :: 
  "'node SDG_node  'node SDG_node list  'node SDG_node  bool"
("_ i-_d* _" [51,0,0] 80) 

where iSp_Nil:
  "valid_SDG_node n  n i-[]d* n"

  | iSp_Append_cdep:
  "n i-nsd* n''; n''cd n'  n i-ns@[n'']d* n'"

  | iSp_Append_ddep:
  "n i-nsd* n''; n'' -Vdd n'; n''  n'  n i-ns@[n'']d* n'"


lemma intra_SDG_path_Append:
  "n'' i-ns'd* n'; n i-nsd* n''  n i-ns@ns'd* n'"
by(induct rule:intra_SDG_path.induct,
   auto intro:intra_SDG_path.intros simp:append_assoc[THEN sym] simp del:append_assoc)


lemma intra_SDG_path_valid_SDG_node:
  assumes "n i-nsd* n'" shows "valid_SDG_node n" and "valid_SDG_node n'"
using n i-nsd* n'
by(induct rule:intra_SDG_path.induct,
   auto intro:SDG_edge_valid_SDG_node valid_SDG_CFG_node)


lemma intra_SDG_path_intra_CFG_path:
  assumes "n i-nsd* n'"
  obtains as where "parent_node n -asι* parent_node n'" 
proof(atomize_elim)
  from n i-nsd* n'
  show "as. parent_node n -asι* parent_node n'"
  proof(induct rule:intra_SDG_path.induct)
    case (iSp_Nil n)
    from ‹valid_SDG_node n have "valid_node (parent_node n)"
      by(rule valid_SDG_CFG_node)
    hence "parent_node n -[]→* parent_node n" by(rule empty_path)
    thus ?case by(auto simp:intra_path_def)
  next
    case (iSp_Append_cdep n ns n'' n')
    from as. parent_node n -asι* parent_node n''
    obtain as where "parent_node n -asι* parent_node n''" by blast
    from n''cd n' show ?case
    proof(rule cdep_edge_cases)
      assume "parent_node n'' controls parent_node n'"
      then obtain as' where "parent_node n'' -as'ι* parent_node n'" and "as'  []"
        by(erule control_dependence_path)
      with ‹parent_node n -asι* parent_node n'' 
      have "parent_node n -as@as'ι* parent_node n'" by -(rule intra_path_Append)
      thus ?thesis by blast
    next
      fix a Q r p fs a'
      assume "valid_edge a" and "kind a = Q:rpfs" and "a'  get_return_edges a"
        and "parent_node n'' = targetnode a" and "parent_node n' = sourcenode a'"
      then obtain a'' where "valid_edge a''" and "sourcenode a'' = targetnode a"
        and "targetnode a'' = sourcenode a'" and "kind a'' = (λcf. False)"
        by(auto dest:intra_proc_additional_edge)
      hence "targetnode a -[a'']ι* sourcenode a'"
        by(fastforce dest:path_edge simp:intra_path_def intra_kind_def)
      with ‹parent_node n'' = targetnode a ‹parent_node n' = sourcenode a' 
      have "as'. parent_node n'' -as'ι* parent_node n'  as'  []" by fastforce
      then obtain as' where "parent_node n'' -as'ι* parent_node n'" and "as'  []"
        by blast
      with ‹parent_node n -asι* parent_node n''
      have "parent_node n -as@as'ι* parent_node n'" by -(rule intra_path_Append)
      thus ?thesis by blast
    next
      fix m assume "n'' = CFG_node m" and "m = parent_node n'"
      with ‹parent_node n -asι* parent_node n'' show ?thesis by fastforce
    qed
  next
    case (iSp_Append_ddep n ns n'' V n')
    from as. parent_node n -asι* parent_node n''
    obtain as where "parent_node n -asι* parent_node n''" by blast 
    from n'' -Vdd n' have "n'' influences V in n'"
      by(fastforce elim:SDG_edge.cases)
    then obtain as' where "parent_node n'' -as'ι* parent_node n'"
      by(auto simp:data_dependence_def)
    with ‹parent_node n -asι* parent_node n'' 
    have "parent_node n -as@as'ι* parent_node n'" by -(rule intra_path_Append)
    thus ?case by blast
  qed
qed


subsection ‹Control dependence paths in the SDG›

inductive cdep_SDG_path :: 
  "'node SDG_node  'node SDG_node list  'node SDG_node  bool"
("_ cd-_d* _" [51,0,0] 80) 

where cdSp_Nil:
  "valid_SDG_node n  n cd-[]d* n"

  | cdSp_Append_cdep:
  "n cd-nsd* n''; n''cd n'  n cd-ns@[n'']d* n'"


lemma cdep_SDG_path_intra_SDG_path:
  "n cd-nsd* n'  n i-nsd* n'"
by(induct rule:cdep_SDG_path.induct,auto intro:intra_SDG_path.intros)


lemma Entry_cdep_SDG_path:
  assumes "(_Entry_) -asι* n'" and "inner_node n'" and "¬ method_exit n'"
  obtains ns where "CFG_node (_Entry_) cd-nsd* CFG_node n'"
  and "ns  []" and "n''  set ns. parent_node n''  set(sourcenodes as)"
proof(atomize_elim)
  from (_Entry_) -asι* n' ‹inner_node n' ¬ method_exit n'
  show "ns. CFG_node (_Entry_) cd-nsd* CFG_node n'  ns  [] 
    (n''  set ns. parent_node n''  set(sourcenodes as))"
  proof(induct as arbitrary:n' rule:length_induct)
    fix as n'
    assume IH:"as'. length as' < length as 
      (n''. (_Entry_) -as'ι* n''  inner_node n''  ¬ method_exit n'' 
        (ns. CFG_node (_Entry_) cd-nsd* CFG_node n''  ns  [] 
              (nxset ns. parent_node nx  set (sourcenodes as'))))"
      and "(_Entry_) -asι* n'" and "inner_node n'" and "¬ method_exit n'"
    thus "ns. CFG_node (_Entry_) cd-nsd* CFG_node n'  ns  [] 
      (n''set ns. parent_node n''  set (sourcenodes as))"
    proof -
      have "ax asx zs. (_Entry_) -ax#asxι* n'  n'  set (sourcenodes (ax#asx))  
                        as = (ax#asx)@zs"
      proof(cases "n'  set (sourcenodes as)")
        case True
        hence "n''  set(sourcenodes as). n' = n''" by simp
        then obtain ns' ns'' where "sourcenodes as = ns'@n'#ns''"
          and "n''  set ns'. n'  n''"
          by(fastforce elim!:split_list_first_propE)
        from ‹sourcenodes as = ns'@n'#ns'' obtain xs ys ax
          where "sourcenodes xs = ns'" and "as = xs@ax#ys"
          and "sourcenode ax = n'"
          by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
        from n''  set ns'. n'  n'' ‹sourcenodes xs = ns'
        have "n'  set(sourcenodes xs)" by fastforce
        from (_Entry_) -asι* n' as = xs@ax#ys have "(_Entry_) -xs@ax#ysι* n'"
          by simp
        with sourcenode ax = n' have "(_Entry_) -xsι* n'" 
          by(fastforce dest:path_split simp:intra_path_def)
        with ‹inner_node n' have "xs  []"
          by(fastforce elim:path.cases simp:intra_path_def)
        with n'  set(sourcenodes xs) (_Entry_) -xsι* n' as = xs@ax#ys
        show ?thesis by(cases xs) auto
      next
        case False
        with (_Entry_) -asι* n' ‹inner_node n'
        show ?thesis by(cases as)(auto elim:path.cases simp:intra_path_def)
      qed
      then obtain ax asx zs where "(_Entry_) -ax#asxι* n'" 
        and "n'  set (sourcenodes (ax#asx))" and "as = (ax#asx)@zs" by blast
      show ?thesis
      proof(cases "a' a''. a'  set asx  sourcenode a' = sourcenode a''  
          valid_edge a''  intra_kind(kind a'')  n' postdominates targetnode a''")
        case True
        have "(_Exit_) -[]ι* (_Exit_)" 
          by(fastforce intro:empty_path simp:intra_path_def)
        hence "¬ n' postdominates (_Exit_)"
          by(fastforce simp:postdominate_def sourcenodes_def method_exit_def)
        from (_Entry_) -ax#asxι* n' have "(_Entry_) -[]@ax#asxι* n'" by simp
        from (_Entry_) -ax#asxι* n' have [simp]:"sourcenode ax = (_Entry_)" 
          and "valid_edge ax"
          by(auto intro:path_split_Cons simp:intra_path_def)
        from Entry_Exit_edge obtain a' where "sourcenode a' = (_Entry_)"
          and "targetnode a' = (_Exit_)" and "valid_edge a'" 
          and "intra_kind(kind a')" by(auto simp:intra_kind_def)
        with (_Entry_) -[]@ax#asxι* n' ¬ n' postdominates (_Exit_)
          valid_edge ax True sourcenode ax = (_Entry_) 
          n'  set (sourcenodes (ax#asx)) ‹inner_node n' ¬ method_exit n'
        have "sourcenode ax controls n'"
          by -(erule which_node_intra_standard_control_dependence_source
                     [of _ _ _ _ _ _ a'],auto)
        hence "CFG_node (_Entry_)cd CFG_node n'"
          by(fastforce intro:SDG_cdep_edge)
        hence "CFG_node (_Entry_) cd-[]@[CFG_node (_Entry_)]d* CFG_node n'"
          by(fastforce intro:cdSp_Append_cdep cdSp_Nil)
        moreover
        from as = (ax#asx)@zs have "(_Entry_)  set(sourcenodes as)"
          by(simp add:sourcenodes_def)
        ultimately show ?thesis by fastforce
      next
        case False
        hence "a'  set asx. a''. sourcenode a' = sourcenode a''  valid_edge a'' 
          intra_kind(kind a'')  ¬ n' postdominates targetnode a''"
          by fastforce
        then obtain ax' asx' asx'' where "asx = asx'@ax'#asx'' 
          (a''. sourcenode ax' = sourcenode a''  valid_edge a'' 
          intra_kind(kind a'')  ¬ n' postdominates targetnode a'') 
          (z  set asx''. ¬ (a''. sourcenode z = sourcenode a''  valid_edge a'' 
          intra_kind(kind a'')  ¬ n' postdominates targetnode a''))"
          by(blast elim!:split_list_last_propE)
        then obtain ai where "asx = asx'@ax'#asx''"
          and "sourcenode ax' = sourcenode ai"
          and "valid_edge ai" and "intra_kind(kind ai)"
          and "¬ n' postdominates targetnode ai"
          and "z  set asx''. ¬ (a''. sourcenode z = sourcenode a''  
          valid_edge a''  intra_kind(kind a'')  ¬ n' postdominates targetnode a'')"
          by blast
        from (_Entry_) -ax#asxι* n' asx = asx'@ax'#asx''
        have "(_Entry_) -(ax#asx')@ax'#asx''ι* n'" by simp
        from n'  set (sourcenodes (ax#asx)) asx = asx'@ax'#asx''
        have "n'  set (sourcenodes (ax'#asx''))"
          by(auto simp:sourcenodes_def)
        with ‹inner_node n' ¬ n' postdominates targetnode ai
          n'  set (sourcenodes (ax'#asx'')) sourcenode ax' = sourcenode ai
          z  set asx''. ¬ (a''. sourcenode z = sourcenode a''  
          valid_edge a''  intra_kind(kind a'')  ¬ n' postdominates targetnode a'')
          valid_edge ai ‹intra_kind(kind ai) ¬ method_exit n'
          (_Entry_) -(ax#asx')@ax'#asx''ι* n'
        have "sourcenode ax' controls n'"
          by(fastforce intro!:which_node_intra_standard_control_dependence_source)
        hence "CFG_node (sourcenode ax')cd CFG_node n'"
          by(fastforce intro:SDG_cdep_edge)
        from (_Entry_) -(ax#asx')@ax'#asx''ι* n'
        have "(_Entry_) -ax#asx'ι* sourcenode ax'" and "valid_edge ax'"
          by(auto intro:path_split simp:intra_path_def simp del:append_Cons)
        from asx = asx'@ax'#asx'' as = (ax#asx)@zs
        have "length (ax#asx') < length as" by simp
        from valid_edge ax' have "valid_node (sourcenode ax')" by simp
        hence "inner_node (sourcenode ax')"
        proof(cases "sourcenode ax'" rule:valid_node_cases)
          case Entry 
          with (_Entry_) -ax#asx'ι* sourcenode ax'
          have "(_Entry_) -ax#asx'→* (_Entry_)" by(simp add:intra_path_def)
          hence False by(fastforce dest:path_Entry_target)
          thus ?thesis by simp
        next
          case Exit
          with valid_edge ax' have False by(rule Exit_source)
          thus ?thesis by simp
        qed simp
        from asx = asx'@ax'#asx'' (_Entry_) -ax#asxι* n'
        have "intra_kind (kind ax')" by(simp add:intra_path_def)
        have "¬ method_exit (sourcenode ax')"
        proof
          assume "method_exit (sourcenode ax')"
          thus False
          proof(rule method_exit_cases)
            assume "sourcenode ax' = (_Exit_)"
            with valid_edge ax' show False by(rule Exit_source)
          next
            fix x Q f p assume " sourcenode ax' = sourcenode x"
              and "valid_edge x" and "kind x = Qpf"
            from valid_edge x kind x = Qpf sourcenode ax' = sourcenode x
            valid_edge ax' ‹intra_kind (kind ax') show False
              by(fastforce dest:return_edges_only simp:intra_kind_def)
          qed
        qed
        with IH ‹length (ax#asx') < length as (_Entry_) -ax#asx'ι* sourcenode ax'
          ‹inner_node (sourcenode ax')
        obtain ns where "CFG_node (_Entry_) cd-nsd* CFG_node (sourcenode ax')"
          and "ns  []" 
          and "n''  set ns. parent_node n''  set(sourcenodes (ax#asx'))"
          by blast
        from ‹CFG_node (_Entry_) cd-nsd* CFG_node (sourcenode ax')
          ‹CFG_node (sourcenode ax')cd CFG_node n'
        have "CFG_node (_Entry_) cd-ns@[CFG_node (sourcenode ax')]d* CFG_node n'"
          by(fastforce intro:cdSp_Append_cdep)
        from as = (ax#asx)@zs asx = asx'@ax'#asx''
        have "sourcenode ax'  set(sourcenodes as)" by(simp add:sourcenodes_def)
        with n''  set ns. parent_node n''  set(sourcenodes (ax#asx'))
          as = (ax#asx)@zs asx = asx'@ax'#asx''
        have "n''  set (ns@[CFG_node (sourcenode ax')]).
          parent_node n''  set(sourcenodes as)"
          by(fastforce simp:sourcenodes_def)
        with ‹CFG_node (_Entry_) cd-ns@[CFG_node (sourcenode ax')]d* CFG_node n'
        show ?thesis by fastforce
      qed
    qed
  qed
qed


lemma in_proc_cdep_SDG_path:
  assumes "n -asι* n'" and "n  n'" and "n'  (_Exit_)" and "valid_edge a"
  and "kind a = Q:rpfs" and "targetnode a = n"
  obtains ns where "CFG_node n cd-nsd* CFG_node n'"
  and "ns  []" and "n''  set ns. parent_node n''  set(sourcenodes as)"
proof(atomize_elim)
  show "ns. CFG_node n cd-nsd* CFG_node n' 
             ns  []  (n''set ns. parent_node n''  set (sourcenodes as))"
  proof(cases "ax. valid_edge ax  sourcenode ax = n'  
                    ax  get_return_edges a")
    case True
    from n -asι* n' n  n' n'  (_Exit_)
      ax. valid_edge ax  sourcenode ax = n'  ax  get_return_edges a
    show "ns. CFG_node n cd-nsd* CFG_node n'  ns  [] 
      (n''  set ns. parent_node n''  set(sourcenodes as))"
    proof(induct as arbitrary:n' rule:length_induct)
      fix as n'
      assume IH:"as'. length as' < length as 
        (n''. n -as'ι* n''  n  n''  n''  (_Exit_) 
          (ax. valid_edge ax  sourcenode ax = n''  ax  get_return_edges a) 
            (ns. CFG_node n cd-nsd* CFG_node n''  ns  [] 
                  (n''set ns. parent_node n''  set (sourcenodes as'))))"
        and "n -asι* n'" and "n  n'" and "n'  (_Exit_)"
        and "ax. valid_edge ax  sourcenode ax = n'  ax  get_return_edges a"
      show "ns. CFG_node n cd-nsd* CFG_node n'  ns  [] 
                 (n''set ns. parent_node n''  set (sourcenodes as))"
      proof(cases "method_exit n'")
        case True
        thus ?thesis
        proof(rule method_exit_cases)
          assume "n' = (_Exit_)"
          with n'  (_Exit_) have False by simp
          thus ?thesis by simp
        next
          fix a' Q' f' p'
          assume "n' = sourcenode a'" and "valid_edge a'" and "kind a' = Q'p'f'"
          from valid_edge a kind a = Q:rpfs have "get_proc(targetnode a) = p"
            by(rule get_proc_call)
          from n -asι* n' have "get_proc n = get_proc n'" 
            by(rule intra_path_get_procs)
          with get_proc(targetnode a) = p targetnode a = n
          have "get_proc (targetnode a) = get_proc n'" by simp
          from valid_edge a' kind a' = Q'p'f'
          have "get_proc (sourcenode a') = p'" by(rule get_proc_return)
          with n' = sourcenode a' get_proc (targetnode a) = get_proc n' 
            get_proc (targetnode a) = p have "p = p'" by simp
          with valid_edge a' kind a' = Q'p'f'
          obtain ax where "valid_edge ax" and "Q r fs. kind ax = Q:rpfs"
            and "a'  get_return_edges ax" by(auto dest:return_needs_call)
          hence "CFG_node (targetnode ax)cd CFG_node (sourcenode a')"
            by(fastforce intro:SDG_proc_entry_exit_cdep)
          with valid_edge ax 
          have "CFG_node (targetnode ax) cd-[]@[CFG_node (targetnode ax)]d* 
            CFG_node (sourcenode a')"
            by(fastforce intro:cdep_SDG_path.intros)
          from valid_edge a kind a = Q:rpfs valid_edge ax 
            Q r fs. kind ax = Q:rpfs have "targetnode a = targetnode ax"
            by(fastforce intro:same_proc_call_unique_target)
          from n -asι* n' n  n'
          have "as  []" by(fastforce elim:path.cases simp:intra_path_def)
          with n -asι* n' have "hd (sourcenodes as) = n"
            by(fastforce intro:path_sourcenode simp:intra_path_def)
          moreover
          from as  [] have "hd (sourcenodes as)  set (sourcenodes as)"
            by(fastforce intro:hd_in_set simp:sourcenodes_def)
          ultimately have "n  set (sourcenodes as)" by simp
          with n' = sourcenode a' targetnode a = targetnode ax
            targetnode a = n
            ‹CFG_node (targetnode ax) cd-[]@[CFG_node (targetnode ax)]d* 
            CFG_node (sourcenode a')
          show ?thesis by fastforce
        qed
      next
        case False
        from valid_edge a kind a = Q:rpfs obtain a' 
          where "a'  get_return_edges a"
          by(fastforce dest:get_return_edge_call)
        with valid_edge a kind a = Q:rpfs obtain Q' f' where "kind a' = Q'pf'"
          by(fastforce dest!:call_return_edges)
        with valid_edge a kind a = Q:rpfs a'  get_return_edges a obtain a''
          where "valid_edge a''" and "sourcenode a'' = targetnode a" 
          and "targetnode a'' = sourcenode a'" and "kind a'' = (λcf. False)"
          by -(drule intra_proc_additional_edge,auto)
        from valid_edge a a'  get_return_edges a have "valid_edge a'"
          by(rule get_return_edges_valid)
        have "ax asx zs. n -ax#asxι* n'  n'  set (sourcenodes (ax#asx))  
                          as = (ax#asx)@zs"
        proof(cases "n'  set (sourcenodes as)")
          case True
          hence "n''  set(sourcenodes as). n' = n''" by simp
          then obtain ns' ns'' where "sourcenodes as = ns'@n'#ns''"
            and "n''  set ns'. n'  n''"
            by(fastforce elim!:split_list_first_propE)
          from ‹sourcenodes as = ns'@n'#ns'' obtain xs ys ax
            where "sourcenodes xs = ns'" and "as = xs@ax#ys"
            and "sourcenode ax = n'"
            by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
          from n''  set ns'. n'  n'' ‹sourcenodes xs = ns'
          have "n'  set(sourcenodes xs)" by fastforce
          from n -asι* n' as = xs@ax#ys have "n -xs@ax#ysι* n'" by simp
          with sourcenode ax = n' have "n -xsι* n'" 
            by(fastforce dest:path_split simp:intra_path_def)
          with n  n' have "xs  []" by(fastforce simp:intra_path_def)
          with n'  set(sourcenodes xs) n -xsι* n' as = xs@ax#ys show ?thesis
            by(cases xs) auto
        next
          case False
          with n -asι* n' n  n' 
          show ?thesis by(cases as)(auto simp:intra_path_def)
        qed
        then obtain ax asx zs where "n -ax#asxι* n'" 
          and "n'  set (sourcenodes (ax#asx))" and "as = (ax#asx)@zs" by blast
        from n -ax#asxι* n' n'  (_Exit_) have "inner_node n'"
          by(fastforce intro:path_valid_node simp:inner_node_def intra_path_def)
        from valid_edge a targetnode a = n have "valid_node n" by fastforce
        show ?thesis
        proof(cases "a' a''. a'  set asx  sourcenode a' = sourcenode a''  
            valid_edge a''  intra_kind(kind a'')  
            n' postdominates targetnode a''")
          case True
          from targetnode a = n sourcenode a'' = targetnode a 
            kind a'' = (λcf. False)
          have "sourcenode a'' = n" and "intra_kind(kind a'')"
            by(auto simp:intra_kind_def)
          { fix as' assume "targetnode a'' -as'ι* n'"
            from valid_edge a' targetnode a'' = sourcenode a' 
              a'  get_return_edges a 
              ax. valid_edge ax  sourcenode ax = n'  ax  get_return_edges a
            have "targetnode a''  n'" by fastforce
            with targetnode a'' -as'ι* n' obtain ax' where "valid_edge ax'"
              and "targetnode a'' = sourcenode ax'" and "intra_kind(kind ax')"
              by(clarsimp simp:intra_path_def)(erule path.cases,fastforce+)
            from valid_edge a' kind a' = Q'pf' valid_edge ax'
              targetnode a'' = sourcenode a' targetnode a'' = sourcenode ax'
              ‹intra_kind(kind ax')
            have False by(fastforce dest:return_edges_only simp:intra_kind_def) }
          hence "¬ n' postdominates targetnode a''"
            by(fastforce elim:postdominate_implies_inner_path)
          from n -ax#asxι* n' have "sourcenode ax = n"
            by(auto intro:path_split_Cons simp:intra_path_def)
          from n -ax#asxι* n' have "n -[]@ax#asxι* n'" by simp
          from this sourcenode a'' = n sourcenode ax = n True
            n'  set (sourcenodes (ax#asx)) valid_edge a'' ‹intra_kind(kind a'')
            ‹inner_node n' ¬ method_exit n' ¬ n' postdominates targetnode a''
          have "n controls n'"
            by(fastforce intro!:which_node_intra_standard_control_dependence_source)
          hence "CFG_node ncd CFG_node n'"
            by(fastforce intro:SDG_cdep_edge)
          with ‹valid_node n have "CFG_node n cd-[]@[CFG_node n]d* CFG_node n'"
            by(fastforce intro:cdSp_Append_cdep cdSp_Nil)
          moreover
          from as = (ax#asx)@zs sourcenode ax = n have "n  set(sourcenodes as)"
            by(simp add:sourcenodes_def)
          ultimately show ?thesis by fastforce
        next
          case False
          hence "a'  set asx. a''. sourcenode a' = sourcenode a''  
            valid_edge a''  intra_kind(kind a'')  
            ¬ n' postdominates targetnode a''"
            by fastforce
          then obtain ax' asx' asx'' where "asx = asx'@ax'#asx'' 
            (a''. sourcenode ax' = sourcenode a''  valid_edge a'' 
            intra_kind(kind a'')  ¬ n' postdominates targetnode a'') 
            (z  set asx''. ¬ (a''. sourcenode z = sourcenode a''  
            valid_edge a''  intra_kind(kind a'')  
            ¬ n' postdominates targetnode a''))"
            by(blast elim!:split_list_last_propE)
          then obtain ai where "asx = asx'@ax'#asx''"
            and "sourcenode ax' = sourcenode ai"
            and "valid_edge ai" and "intra_kind(kind ai)"
            and "¬ n' postdominates targetnode ai"
            and "z  set asx''. ¬ (a''. sourcenode z = sourcenode a''  
            valid_edge a''  intra_kind(kind a'')  
            ¬ n' postdominates targetnode a'')"
            by blast
          from asx = asx'@ax'#asx'' n -ax#asxι* n'
          have "n -(ax#asx')@ax'#asx''ι* n'" by simp
          from n'  set (sourcenodes (ax#asx)) asx = asx'@ax'#asx''
          have "n'  set (sourcenodes (ax'#asx''))"
            by(auto simp:sourcenodes_def)
          with ‹inner_node n' ¬ n' postdominates targetnode ai
            n -(ax#asx')@ax'#asx''ι* n' sourcenode ax' = sourcenode ai
            z  set asx''. ¬ (a''. sourcenode z = sourcenode a''  
            valid_edge a''  intra_kind(kind a'')  
            ¬ n' postdominates targetnode a'')
            valid_edge ai ‹intra_kind(kind ai) ¬ method_exit n'
          have "sourcenode ax' controls n'"
            by(fastforce intro!:which_node_intra_standard_control_dependence_source)
          hence "CFG_node (sourcenode ax')cd CFG_node n'"
            by(fastforce intro:SDG_cdep_edge)
          from n -(ax#asx')@ax'#asx''ι* n'
          have "n -ax#asx'ι* sourcenode ax'" and "valid_edge ax'"
            by(auto intro:path_split simp:intra_path_def simp del:append_Cons)
          from asx = asx'@ax'#asx'' as = (ax#asx)@zs
          have "length (ax#asx') < length as" by simp
          from as = (ax#asx)@zs asx = asx'@ax'#asx''
          have "sourcenode ax'  set(sourcenodes as)" by(simp add:sourcenodes_def)
          show ?thesis
          proof(cases "n = sourcenode ax'")
            case True
            with ‹CFG_node (sourcenode ax')cd CFG_node n' valid_edge ax'
            have "CFG_node n cd-[]@[CFG_node n]d* CFG_node n'"
              by(fastforce intro:cdSp_Append_cdep cdSp_Nil)
            with sourcenode ax'  set(sourcenodes as) True show ?thesis by fastforce
          next
            case False
            from valid_edge ax' have "sourcenode ax'  (_Exit_)"
              by -(rule ccontr,fastforce elim!:Exit_source)
            from n -ax#asx'ι* sourcenode ax' have "n = sourcenode ax"
              by(fastforce intro:path_split_Cons simp:intra_path_def)
            show ?thesis
            proof(cases "ax. valid_edge ax  sourcenode ax = sourcenode ax' 
                ax  get_return_edges a")
              case True
              from asx = asx'@ax'#asx'' n -ax#asxι* n'
              have "intra_kind (kind ax')" by(simp add:intra_path_def)
              have "¬ method_exit (sourcenode ax')"
              proof
                assume "method_exit (sourcenode ax')"
                thus False
                proof(rule method_exit_cases)
                  assume "sourcenode ax' = (_Exit_)"
                  with valid_edge ax' show False by(rule Exit_source)
                next
                  fix x Q f p assume " sourcenode ax' = sourcenode x"
                    and "valid_edge x" and "kind x = Qpf"
                  from valid_edge x kind x = Qpf sourcenode ax' = sourcenode x
                    valid_edge ax' ‹intra_kind (kind ax') show False
                    by(fastforce dest:return_edges_only simp:intra_kind_def)
                qed
              qed
              with IH ‹length (ax#asx') < length as n -ax#asx'ι* sourcenode ax'
                n  sourcenode ax' sourcenode ax'  (_Exit_) True
              obtain ns where "CFG_node n cd-nsd* CFG_node (sourcenode ax')"
                and "ns  []" 
                and "n''set ns. parent_node n''  set (sourcenodes (ax#asx'))"
                by blast
              from ‹CFG_node n cd-nsd* CFG_node (sourcenode ax')
                ‹CFG_node (sourcenode ax')cd CFG_node n'
              have "CFG_node n cd-ns@[CFG_node (sourcenode ax')]d* CFG_node n'"
                by(rule cdSp_Append_cdep)
              moreover
              from n''set ns. parent_node n''  set (sourcenodes (ax#asx'))
                asx = asx'@ax'#asx'' as = (ax#asx)@zs
                sourcenode ax'  set(sourcenodes as)
              have "n''set (ns@[CFG_node (sourcenode ax')]). 
                parent_node n''  set (sourcenodes as)"
                by(fastforce simp:sourcenodes_def)
              ultimately show ?thesis by fastforce
            next
              case False
              then obtain ai' where "valid_edge ai'" 
                and "sourcenode ai' = sourcenode ax'" 
                and "ai'  get_return_edges a" by blast
              with valid_edge a kind a = Q:rpfs targetnode a = n
              have "CFG_node ncd CFG_node (sourcenode ax')"
                by(fastforce intro!:SDG_proc_entry_exit_cdep[of _ _ _ _ _ _ ai'])
              with ‹valid_node n
              have "CFG_node n cd-[]@[CFG_node n]d* CFG_node (sourcenode ax')"
                by(fastforce intro:cdSp_Append_cdep cdSp_Nil)
              with ‹CFG_node (sourcenode ax')cd CFG_node n'
              have "CFG_node n cd-[CFG_node n]@[CFG_node (sourcenode ax')]d* 
                CFG_node n'"
                by(fastforce intro:cdSp_Append_cdep)
              moreover
              from sourcenode ax'  set(sourcenodes as) n = sourcenode ax
                as = (ax#asx)@zs
              have "n''set ([CFG_node n]@[CFG_node (sourcenode ax')]). 
                parent_node n''  set (sourcenodes as)"
                by(fastforce simp:sourcenodes_def)
              ultimately show ?thesis by fastforce
            qed
          qed
        qed
      qed
    qed
  next
    case False
    then obtain a' where "valid_edge a'" and "sourcenode a' = n'"
      and "a'  get_return_edges a" by auto
    with valid_edge a kind a = Q:rpfs targetnode a = n
    have "CFG_node ncd CFG_node n'" by(fastforce intro:SDG_proc_entry_exit_cdep)
    with valid_edge a targetnode a = n[THEN sym] 
    have "CFG_node n cd-[]@[CFG_node n]d* CFG_node n'"
      by(fastforce intro:cdep_SDG_path.intros)
    from n -asι* n' n  n' have "as  []"
      by(fastforce elim:path.cases simp:intra_path_def)
    with n -asι* n' have "hd (sourcenodes as) = n"
      by(fastforce intro:path_sourcenode simp:intra_path_def)
    with as  [] have "n  set (sourcenodes as)" 
      by(fastforce intro:hd_in_set simp:sourcenodes_def)
    with ‹CFG_node n cd-[]@[CFG_node n]d* CFG_node n'
    show ?thesis by auto
  qed
qed


subsection ‹Paths consisting of calls and control dependences›

inductive call_cdep_SDG_path ::
  "'node SDG_node  'node SDG_node list  'node SDG_node  bool"
("_ cc-_d* _" [51,0,0] 80)
where ccSp_Nil:
  "valid_SDG_node n  n cc-[]d* n"

  | ccSp_Append_cdep:
  "n cc-nsd* n''; n''cd n'  n cc-ns@[n'']d* n'"

  | ccSp_Append_call:
  "n cc-nsd* n''; n'' -pcall n'  n cc-ns@[n'']d* n'"


lemma cc_SDG_path_Append:
  "n'' cc-ns'd* n'; n cc-nsd* n''  n cc-ns@ns'd* n'"
by(induct rule:call_cdep_SDG_path.induct,
   auto intro:call_cdep_SDG_path.intros simp:append_assoc[THEN sym] 
                                        simp del:append_assoc)


lemma cdep_SDG_path_cc_SDG_path:
  "n cd-nsd* n'  n cc-nsd* n'"
by(induct rule:cdep_SDG_path.induct,auto intro:call_cdep_SDG_path.intros)


lemma Entry_cc_SDG_path_to_inner_node:
  assumes "valid_SDG_node n" and "parent_node n  (_Exit_)"
  obtains ns where "CFG_node (_Entry_) cc-nsd* n"
proof(atomize_elim)
  obtain m where "m = parent_node n" by simp
  from ‹valid_SDG_node n have "valid_node (parent_node n)" 
    by(rule valid_SDG_CFG_node)
  thus "ns. CFG_node (_Entry_) cc-nsd* n"
  proof(cases "parent_node n" rule:valid_node_cases)
    case Entry
    with ‹valid_SDG_node n have "n = CFG_node (_Entry_)" 
      by(rule valid_SDG_node_parent_Entry)
    with ‹valid_SDG_node n show ?thesis by(fastforce intro:ccSp_Nil)
  next
    case Exit
    with ‹parent_node n  (_Exit_) have False by simp
    thus ?thesis by simp
  next
    case inner
    with m = parent_node n obtain asx where "(_Entry_) -asx* m"
      by(fastforce dest:Entry_path inner_is_valid)
    then obtain as where "(_Entry_) -as* m"
      and "a'  set as. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)"
      by -(erule valid_Entry_path_ascending_path,fastforce)
    from ‹inner_node (parent_node n) m = parent_node n
    have "inner_node m" by simp
    with (_Entry_) -as* m m = parent_node n ‹valid_SDG_node n
      a'  set as. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)
    show ?thesis
    proof(induct as arbitrary:m n rule:length_induct)
      fix as m n
      assume IH:"as'. length as' < length as 
        (m'. (_Entry_) -as'* m' 
        (n'. m' = parent_node n'  valid_SDG_node n' 
        (a'  set as'. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)) 
        inner_node m'  (ns. CFG_node (_Entry_) cc-nsd* n')))"
        and "(_Entry_) -as* m" 
        and "m = parent_node n" and "valid_SDG_node n" and "inner_node m"
        and "a'  set as. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)"
      show "ns. CFG_node (_Entry_) cc-nsd* n"
      proof(cases "a'  set as. intra_kind(kind a')")
        case True
        with (_Entry_) -as* m have "(_Entry_) -asι* m"
          by(fastforce simp:intra_path_def vp_def)
        have "¬ method_exit m"
        proof
          assume "method_exit m"
          thus False
          proof(rule method_exit_cases)
            assume "m = (_Exit_)"
            with ‹inner_node m show False by(simp add:inner_node_def)
          next
            fix a Q f p assume "m = sourcenode a" and "valid_edge a"
              and "kind a = Qpf"
            from (_Entry_) -asι* m have "get_proc m = Main"
              by(fastforce dest:intra_path_get_procs simp:get_proc_Entry)
            from valid_edge a kind a = Qpf
            have "get_proc (sourcenode a) = p" by(rule get_proc_return)
            with get_proc m = Main m = sourcenode a have "p = Main" by simp
            with valid_edge a kind a = Qpf show False
              by(fastforce intro:Main_no_return_source)
          qed
        qed
        with ‹inner_node m (_Entry_) -asι* m
        obtain ns where "CFG_node (_Entry_) cd-nsd* CFG_node m"
          and "ns  []" and "n''  set ns. parent_node n''  set(sourcenodes as)"
          by -(erule Entry_cdep_SDG_path)
        then obtain n' where "n'cd CFG_node m"
          and "parent_node n'  set(sourcenodes as)"
          by -(erule cdep_SDG_path.cases,auto)
        from ‹parent_node n'  set(sourcenodes as) obtain ms ms' 
          where "sourcenodes as = ms@(parent_node n')#ms'"
          by(fastforce dest:split_list simp:sourcenodes_def)
        then obtain as' a as'' where "ms = sourcenodes as'" 
          and "ms' = sourcenodes as''" and "as = as'@a#as''" 
          and "parent_node n' = sourcenode a"
          by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
        with (_Entry_) -asι* m have "(_Entry_) -as'ι* parent_node n'"
          by(fastforce intro:path_split simp:intra_path_def)
        from n'cd CFG_node m have "valid_SDG_node n'"
          by(rule SDG_edge_valid_SDG_node)
        hence n'_cases:
          "n' = CFG_node (parent_node n')  CFG_node (parent_node n')cd n'"
          by(rule valid_SDG_node_cases)
        show ?thesis
        proof(cases "as' = []")
          case True
          with (_Entry_) -as'ι* parent_node n' have "parent_node n' = (_Entry_)"
            by(fastforce simp:intra_path_def)
          from n'_cases have "ns. CFG_node (_Entry_) cd-nsd* CFG_node m"
          proof
            assume "n' = CFG_node (parent_node n')"
            with n'cd CFG_node m ‹parent_node n' = (_Entry_)
            have "CFG_node (_Entry_) cd-[]@[CFG_node (_Entry_)]d* CFG_node m"
              by -(rule cdSp_Append_cdep,rule cdSp_Nil,auto)
            thus ?thesis by fastforce
          next
            assume "CFG_node (parent_node n')cd n'"
            with ‹parent_node n' = (_Entry_)
            have "CFG_node (_Entry_) cd-[]@[CFG_node (_Entry_)]d* n'"
              by -(rule cdSp_Append_cdep,rule cdSp_Nil,auto)
            with n'cd CFG_node m
            have "CFG_node (_Entry_) cd-[CFG_node (_Entry_)]@[n']d* CFG_node m"
              by(fastforce intro:cdSp_Append_cdep)
            thus ?thesis by fastforce
          qed
          then obtain ns where "CFG_node (_Entry_) cc-nsd* CFG_node m"
            by(fastforce intro:cdep_SDG_path_cc_SDG_path)
          show ?thesis
          proof(cases "n = CFG_node m")
            case True
            with ‹CFG_node (_Entry_) cc-nsd* CFG_node m 
            show ?thesis by fastforce
          next
            case False
            with ‹inner_node m ‹valid_SDG_node n m = parent_node n
            have "CFG_node mcd n"
              by(fastforce intro:SDG_parent_cdep_edge inner_is_valid)
            with ‹CFG_node (_Entry_) cc-nsd* CFG_node m
            have "CFG_node (_Entry_) cc-ns@[CFG_node m]d* n"
              by(fastforce intro:ccSp_Append_cdep)
            thus ?thesis by fastforce
          qed
        next
          case False
          with as = as'@a#as'' have "length as' < length as" by simp
          from (_Entry_) -as'ι* parent_node n' have "valid_node (parent_node n')"
            by(fastforce intro:path_valid_node simp:intra_path_def)
          hence "inner_node (parent_node n')"
          proof(cases "parent_node n'" rule:valid_node_cases)
            case Entry
            with (_Entry_) -as'ι* (parent_node n')
            have "(_Entry_) -as'→* (_Entry_)" by(fastforce simp:intra_path_def)
            with False have False by fastforce
            thus ?thesis by simp
          next
            case Exit
            with n'cd CFG_node m have "n' = CFG_node (_Exit_)"
              by -(rule valid_SDG_node_parent_Exit,erule SDG_edge_valid_SDG_node,simp)
            with n'cd CFG_node m Exit have False
              by simp(erule Exit_no_SDG_edge_source)
            thus ?thesis by simp
          next
            case inner
            thus ?thesis by simp
          qed
          from ‹valid_node (parent_node n') 
          have "valid_SDG_node (CFG_node (parent_node n'))" by simp
          from (_Entry_) -as'ι* (parent_node n') 
          have "(_Entry_) -as'* (parent_node n')"
            by(rule intra_path_vp)
          from a'  set as. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)
            as = as'@a#as''
          have "a'  set as'. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)"
            by auto
          with IH ‹length as' < length as (_Entry_) -as'* (parent_node n')
            ‹valid_SDG_node (CFG_node (parent_node n')) ‹inner_node (parent_node n')
          obtain ns where "CFG_node (_Entry_) cc-nsd* CFG_node (parent_node n')"
            apply(erule_tac x="as'" in allE) apply clarsimp
            apply(erule_tac x="(parent_node n')" in allE) apply clarsimp
            apply(erule_tac x="CFG_node (parent_node n')" in allE) by clarsimp
          from n'_cases have "ns. CFG_node (_Entry_) cc-nsd* n'"
          proof
            assume "n' = CFG_node (parent_node n')"
            with ‹CFG_node (_Entry_) cc-nsd* CFG_node (parent_node n')
            show ?thesis by fastforce
          next
            assume "CFG_node (parent_node n')cd n'"
            with ‹CFG_node (_Entry_) cc-nsd* CFG_node (parent_node n')
            have "CFG_node (_Entry_) cc-ns@[CFG_node (parent_node n')]d* n'"
              by(fastforce intro:ccSp_Append_cdep)
            thus ?thesis by fastforce
          qed
          then obtain ns' where "CFG_node (_Entry_) cc-ns'd* n'" by blast
          with n'cd CFG_node m 
          have "CFG_node (_Entry_) cc-ns'@[n']d* CFG_node m"
            by(fastforce intro:ccSp_Append_cdep)
          show ?thesis
          proof(cases "n = CFG_node m")
            case True
            with ‹CFG_node (_Entry_) cc-ns'@[n']d* CFG_node m
            show ?thesis by fastforce
          next
            case False
            with ‹inner_node m ‹valid_SDG_node n m = parent_node n
            have "CFG_node mcd n"
              by(fastforce intro:SDG_parent_cdep_edge inner_is_valid)
            with ‹CFG_node (_Entry_) cc-ns'@[n']d* CFG_node m
            have "CFG_node (_Entry_) cc-(ns'@[n'])@[CFG_node m]d* n"
              by(fastforce intro:ccSp_Append_cdep)
            thus ?thesis by fastforce
          qed
        qed
      next
        case False
        hence "a'  set as. ¬ intra_kind (kind a')" by fastforce
        then obtain a as' as'' where "as = as'@a#as''" and "¬ intra_kind (kind a)"
          and "a'  set as''. intra_kind (kind a')"
          by(fastforce elim!:split_list_last_propE)
        from a'  set as. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)
          as = as'@a#as'' ¬ intra_kind (kind a)
        obtain Q r p fs where "kind a = Q:rpfs" 
          and "a'  set as'. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)"
          by auto
        from as = as'@a#as'' have "length as' < length as" by fastforce
        from (_Entry_) -as* m as = as'@a#as''
        have "(_Entry_) -as'* sourcenode a" and "valid_edge a"
          and "targetnode a -as''* m"
          by(auto intro:vp_split)
        hence "valid_SDG_node (CFG_node (sourcenode a))" by simp
        have "ns'. CFG_node (_Entry_) cc-ns'd* CFG_node m"
        proof(cases "targetnode a = m")
          case True
          with valid_edge a kind a = Q:rpfs
          have "CFG_node (sourcenode a) -pcall CFG_node m"
            by(fastforce intro:SDG_call_edge)
          have "ns. CFG_node (_Entry_) cc-nsd* CFG_node (sourcenode a)"
          proof(cases "as' = []")
            case True
            with (_Entry_) -as'* sourcenode a have "(_Entry_) = sourcenode a"
              by(fastforce simp:vp_def)
            with ‹CFG_node (sourcenode a) -pcall CFG_node m
            have "CFG_node (_Entry_) cc-[]d* CFG_node (sourcenode a)"
              by(fastforce intro:ccSp_Nil SDG_edge_valid_SDG_node)
            thus ?thesis by fastforce
          next
            case False
            from valid_edge a have "valid_node (sourcenode a)" by simp
            hence "inner_node (sourcenode a)"
            proof(cases "sourcenode a" rule:valid_node_cases)
              case Entry
              with (_Entry_) -as'* sourcenode a
              have "(_Entry_) -as'→* (_Entry_)" by(fastforce simp:vp_def)
              with False have False by fastforce
              thus ?thesis by simp
            next
              case Exit
              with valid_edge a have False by -(erule Exit_source)
              thus ?thesis by simp
            next
              case inner
              thus ?thesis by simp
            qed
            with IH ‹length as' < length as (_Entry_) -as'* sourcenode a
              ‹valid_SDG_node (CFG_node (sourcenode a)) 
              a'  set as'. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)
            obtain ns where "CFG_node (_Entry_) cc-nsd* CFG_node (sourcenode a)"
              apply(erule_tac x="as'" in allE) apply clarsimp
              apply(erule_tac x="sourcenode a" in allE) apply clarsimp
              apply(erule_tac x="CFG_node (sourcenode a)" in allE) by clarsimp
            thus ?thesis by fastforce
          qed
          then obtain ns where "CFG_node (_Entry_) cc-nsd* CFG_node (sourcenode a)"
            by blast
          with ‹CFG_node (sourcenode a) -pcall CFG_node m
          show ?thesis by(fastforce intro:ccSp_Append_call)
        next
          case False
          from targetnode a -as''* m a'  set as''. intra_kind (kind a')
          have "targetnode a -as''ι* m" by(fastforce simp:vp_def intra_path_def)
          hence "get_proc (targetnode a) = get_proc m" by(rule intra_path_get_procs)
          from valid_edge a kind a = Q:rpfs have "get_proc (targetnode a) = p"
            by(rule get_proc_call)
          from ‹inner_node m valid_edge a targetnode a -as''ι* m
            kind a = Q:rpfs targetnode a  m
          obtain ns where "CFG_node (targetnode a) cd-nsd* CFG_node m"
            and "ns  []" 
            and "n''  set ns. parent_node n''  set(sourcenodes as'')"
            by(fastforce elim!:in_proc_cdep_SDG_path)
          then obtain n' where "n'cd CFG_node m"
            and "parent_node n'  set(sourcenodes as'')"
            by -(erule cdep_SDG_path.cases,auto)
          from (parent_node n')  set(sourcenodes as'') obtain ms ms' 
            where "sourcenodes as'' = ms@(parent_node n')#ms'"
            by(fastforce dest:split_list simp:sourcenodes_def)
          then obtain xs a' ys where "ms = sourcenodes xs" 
            and "ms' = sourcenodes ys" and "as'' = xs@a'#ys"
            and "parent_node n' = sourcenode a'"
            by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
          from (_Entry_) -as* m as = as'@a#as'' as'' = xs@a'#ys
          have "(_Entry_) -(as'@a#xs)@a'#ys* m" by simp
          hence "(_Entry_) -as'@a#xs* sourcenode a'"
            and "valid_edge a'" by(auto intro:vp_split)
          from as = as'@a#as'' as'' = xs@a'#ys 
          have "length (as'@a#xs) < length as" by simp
          from valid_edge a' have "valid_node (sourcenode a')" by simp
          hence "inner_node (sourcenode a')"
          proof(cases "sourcenode a'" rule:valid_node_cases)
            case Entry
            with (_Entry_) -as'@a#xs* sourcenode a'
            have "(_Entry_) -as'@a#xs→* (_Entry_)" by(fastforce simp:vp_def)
            hence False by fastforce
            thus ?thesis by simp
          next
            case Exit
            with valid_edge a' have False by -(erule Exit_source)
            thus ?thesis by simp
          next
            case inner
            thus ?thesis by simp
          qed
          from valid_edge a' have "valid_SDG_node (CFG_node (sourcenode a'))"
            by simp
          from a'  set as. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)
            as = as'@a#as'' as'' = xs@a'#ys
          have "a'  set (as'@a#xs). 
            intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)"
            by auto
          with IH ‹length (as'@a#xs) < length as 
            (_Entry_) -as'@a#xs* sourcenode a'
            ‹valid_SDG_node (CFG_node (sourcenode a'))
            ‹inner_node (sourcenode a') ‹parent_node n' = sourcenode a'
          obtain ns where "CFG_node (_Entry_) cc-nsd* CFG_node (parent_node n')"
            apply(erule_tac x="as'@a#xs" in allE) apply clarsimp
            apply(erule_tac x="sourcenode a'" in allE) apply clarsimp
            apply(erule_tac x="CFG_node (sourcenode a')" in allE) by clarsimp
          from n'cd CFG_node m have "valid_SDG_node n'"
            by(rule SDG_edge_valid_SDG_node)
          hence "n' = CFG_node (parent_node n')  CFG_node (parent_node n')cd n'"
            by(rule valid_SDG_node_cases)
          thus ?thesis
          proof
            assume "n' = CFG_node (parent_node n')"
            with ‹CFG_node (_Entry_) cc-nsd* CFG_node (parent_node n')
              n'cd CFG_node m show ?thesis
              by(fastforce intro:ccSp_Append_cdep)
          next
            assume "CFG_node (parent_node n')cd n'"
            with ‹CFG_node (_Entry_) cc-nsd* CFG_node (parent_node n')
            have "CFG_node (_Entry_) cc-ns@[CFG_node (parent_node n')]d* n'"
              by(fastforce intro:ccSp_Append_cdep)
            with n'cd CFG_node m show ?thesis
              by(fastforce intro:ccSp_Append_cdep)
          qed
        qed
        then obtain ns where "CFG_node (_Entry_) cc-nsd* CFG_node m" by blast
        show ?thesis
        proof(cases "n = CFG_node m")
          case True
          with ‹CFG_node (_Entry_) cc-nsd* CFG_node m show ?thesis by fastforce
        next
          case False
          with ‹inner_node m ‹valid_SDG_node n m = parent_node n
          have "CFG_node mcd n"
            by(fastforce intro:SDG_parent_cdep_edge inner_is_valid)
          with ‹CFG_node (_Entry_) cc-nsd* CFG_node m show ?thesis
            by(fastforce dest:ccSp_Append_cdep)
        qed
      qed
    qed
  qed
qed


subsection ‹Same level paths in the SDG›

inductive matched :: "'node SDG_node  'node SDG_node list  'node SDG_node  bool"
  where matched_Nil:
  "valid_SDG_node n  matched n [] n"
  | matched_Append_intra_SDG_path:
  "matched n ns n''; n'' i-ns'd* n'  matched n (ns@ns') n'"
  | matched_bracket_call:
  "matched n0 ns n1; n1 -pcall n2; matched n2 ns' n3; 
    (n3 -pret n4  n3 -p:Vout n4); valid_edge a; a'  get_return_edges a;
    sourcenode a = parent_node n1; targetnode a = parent_node n2; 
    sourcenode a' = parent_node n3; targetnode a' = parent_node n4
   matched n0 (ns@n1#ns'@[n3]) n4"
  | matched_bracket_param:
  "matched n0 ns n1; n1 -p:Vin n2; matched n2 ns' n3; 
    n3 -p:V'out n4; valid_edge a; a'  get_return_edges a;
    sourcenode a = parent_node n1; targetnode a = parent_node n2; 
    sourcenode a' = parent_node n3; targetnode a' = parent_node n4
   matched n0 (ns@n1#ns'@[n3]) n4"




lemma matched_Append:
  "matched n'' ns' n'; matched n ns n''  matched n (ns@ns') n'"
by(induct rule:matched.induct,
   auto intro:matched.intros simp:append_assoc[THEN sym] simp del:append_assoc)


lemma intra_SDG_path_matched:
  assumes "n i-nsd* n'" shows "matched n ns n'"
proof -
  from n i-nsd* n' have "valid_SDG_node n"
    by(rule intra_SDG_path_valid_SDG_node)
  hence "matched n [] n" by(rule matched_Nil)
  with n i-nsd* n' have "matched n ([]@ns) n'"
    by -(rule matched_Append_intra_SDG_path)
  thus ?thesis by simp
qed


lemma intra_proc_matched:
  assumes "valid_edge a" and "kind a = Q:rpfs" and "a'  get_return_edges a"
  shows "matched (CFG_node (targetnode a)) [CFG_node (targetnode a)]
                 (CFG_node (sourcenode a'))"
proof -
  from assms have "CFG_node (targetnode a)cd CFG_node (sourcenode a')" 
    by(fastforce intro:SDG_proc_entry_exit_cdep)
  with valid_edge a 
  have "CFG_node (targetnode a) i-[]@[CFG_node (targetnode a)]d* 
        CFG_node (sourcenode a')" 
    by(fastforce intro:intra_SDG_path.intros)
  with valid_edge a 
  have "matched (CFG_node (targetnode a)) ([]@[CFG_node (targetnode a)])
    (CFG_node (sourcenode a'))"
    by(fastforce intro:matched.intros)
  thus ?thesis by simp
qed


lemma matched_intra_CFG_path:
  assumes "matched n ns n'"
  obtains as where "parent_node n -asι* parent_node n'"
proof(atomize_elim)
  from ‹matched n ns n' show "as. parent_node n -asι* parent_node n'"
  proof(induct rule:matched.induct)
    case matched_Nil thus ?case
      by(fastforce dest:empty_path valid_SDG_CFG_node simp:intra_path_def)
  next
    case (matched_Append_intra_SDG_path n ns n'' ns' n')
    from as. parent_node n -asι* parent_node n'' obtain as 
      where "parent_node n -asι* parent_node n''" by blast
    from n'' i-ns'd* n' obtain as' where "parent_node n'' -as'ι* parent_node n'"
      by(fastforce elim:intra_SDG_path_intra_CFG_path)
    with ‹parent_node n -asι* parent_node n''
    have "parent_node n -as@as'ι* parent_node n'"
      by(rule intra_path_Append)
    thus ?case by fastforce
  next
    case (matched_bracket_call n0 ns n1 p n2 ns' n3 n4 V a a')
    from valid_edge a a'  get_return_edges a sourcenode a = parent_node n1
      targetnode a' = parent_node n4
    obtain a'' where "valid_edge a''" and "sourcenode a'' = parent_node n1" 
      and "targetnode a'' = parent_node n4" and "kind a'' = (λcf. False)"
      by(fastforce dest:call_return_node_edge)
    hence "parent_node n1 -[a'']→* parent_node n4" by(fastforce dest:path_edge)
    moreover
    from kind a'' = (λcf. False) have "a  set [a'']. intra_kind(kind a)"
      by(fastforce simp:intra_kind_def)
    ultimately have "parent_node n1 -[a'']ι* parent_node n4"
      by(auto simp:intra_path_def)
    with as. parent_node n0 -asι* parent_node n1 show ?case
      by(fastforce intro:intra_path_Append)
  next
    case (matched_bracket_param n0 ns n1 p V n2 ns' n3 V' n4 a a')
    from valid_edge a a'  get_return_edges a sourcenode a = parent_node n1
      targetnode a' = parent_node n4
    obtain a'' where "valid_edge a''" and "sourcenode a'' = parent_node n1" 
      and "targetnode a'' = parent_node n4" and "kind a'' = (λcf. False)"
      by(fastforce dest:call_return_node_edge)
    hence "parent_node n1 -[a'']→* parent_node n4" by(fastforce dest:path_edge)
    moreover
    from kind a'' = (λcf. False) have "a  set [a'']. intra_kind(kind a)"
      by(fastforce simp:intra_kind_def)
    ultimately have "parent_node n1 -[a'']ι* parent_node n4"
      by(auto simp:intra_path_def)
    with as. parent_node n0 -asι* parent_node n1 show ?case
      by(fastforce intro:intra_path_Append)
  qed
qed


lemma matched_same_level_CFG_path:
  assumes "matched n ns n'"
  obtains as where "parent_node n -assl* parent_node n'"
proof(atomize_elim)
  from ‹matched n ns n'
  show "as. parent_node n -assl* parent_node n'"
  proof(induct rule:matched.induct)
    case matched_Nil thus ?case 
      by(fastforce dest:empty_path valid_SDG_CFG_node simp:slp_def same_level_path_def)
  next
    case (matched_Append_intra_SDG_path n ns n'' ns' n')
    from as. parent_node n -assl* parent_node n''
    obtain as where "parent_node n -assl* parent_node n''" by blast
    from n'' i-ns'd* n' obtain as' where "parent_node n'' -as'ι* parent_node n'"
      by(erule intra_SDG_path_intra_CFG_path)
    from ‹parent_node n'' -as'ι* parent_node n'
    have "parent_node n'' -as'sl* parent_node n'" by(rule intra_path_slp)
    with ‹parent_node n -assl* parent_node n''
    have "parent_node n -as@as'sl* parent_node n'"
      by(rule slp_Append)
    thus ?case by fastforce
  next
    case (matched_bracket_call n0 ns n1 p n2 ns' n3 n4 V a a')
    from valid_edge a a'  get_return_edges a
    obtain Q r p' fs where "kind a = Q:rp'fs" 
      by(fastforce dest!:only_call_get_return_edges)
    from as. parent_node n0 -assl* parent_node n1
    obtain as where "parent_node n0 -assl* parent_node n1" by blast
    from as. parent_node n2 -assl* parent_node n3
    obtain as' where "parent_node n2 -as'sl* parent_node n3" by blast
    from valid_edge a a'  get_return_edges a kind a = Q:rp'fs
    obtain Q' f' where "kind a' = Q'p'f'" by(fastforce dest!:call_return_edges)
    from valid_edge a a'  get_return_edges a have "valid_edge a'" 
      by(rule get_return_edges_valid)
    from ‹parent_node n2 -as'sl* parent_node n3 have "same_level_path as'"
      by(simp add:slp_def)
    hence "same_level_path_aux ([]@[a]) as'"
      by(fastforce intro:same_level_path_aux_callstack_Append simp:same_level_path_def)
    from ‹same_level_path as' have "upd_cs ([]@[a]) as' = ([]@[a])"
      by(fastforce intro:same_level_path_upd_cs_callstack_Append 
                   simp:same_level_path_def)
    with ‹same_level_path_aux ([]@[a]) as' a'  get_return_edges a
      kind a = Q:rp'fs kind a' = Q'p'f'
    have "same_level_path (a#as'@[a'])"
      by(fastforce intro:same_level_path_aux_Append upd_cs_Append 
                   simp:same_level_path_def)
    from valid_edge a' sourcenode a' = parent_node n3
      targetnode a' = parent_node n4
    have "parent_node n3 -[a']→* parent_node n4" by(fastforce dest:path_edge)
    with ‹parent_node n2 -as'sl* parent_node n3 
    have "parent_node n2 -as'@[a']→* parent_node n4"
      by(fastforce intro:path_Append simp:slp_def)
    with valid_edge a sourcenode a = parent_node n1
      targetnode a = parent_node n2
    have "parent_node n1 -a#as'@[a']→* parent_node n4" by -(rule Cons_path)
    with ‹same_level_path (a#as'@[a'])
    have "parent_node n1 -a#as'@[a']sl* parent_node n4" by(simp add:slp_def)
    with ‹parent_node n0 -assl* parent_node n1
    have "parent_node n0 -as@a#as'@[a']sl* parent_node n4" by(rule slp_Append)
    with sourcenode a = parent_node n1 sourcenode a' = parent_node n3
    show ?case by fastforce
  next
    case (matched_bracket_param n0 ns n1 p V n2 ns' n3 V' n4 a a')
    from valid_edge a a'  get_return_edges a
    obtain Q r p' fs where "kind a = Q:rp'fs" 
      by(fastforce dest!:only_call_get_return_edges)
    from as. parent_node n0 -assl* parent_node n1
    obtain as where "parent_node n0 -assl* parent_node n1" by blast
    from as. parent_node n2 -assl* parent_node n3
    obtain as' where "parent_node n2 -as'sl* parent_node n3" by blast
    from valid_edge a a'  get_return_edges a kind a = Q:rp'fs
    obtain Q' f' where "kind a' = Q'p'f'" by(fastforce dest!:call_return_edges)
    from valid_edge a a'  get_return_edges a have "valid_edge a'" 
      by(rule get_return_edges_valid)
    from ‹parent_node n2 -as'sl* parent_node n3 have "same_level_path as'"
      by(simp add:slp_def)
    hence "same_level_path_aux ([]@[a]) as'"
      by(fastforce intro:same_level_path_aux_callstack_Append simp:same_level_path_def)
    from ‹same_level_path as' have "upd_cs ([]@[a]) as' = ([]@[a])"
      by(fastforce intro:same_level_path_upd_cs_callstack_Append 
                   simp:same_level_path_def)
    with ‹same_level_path_aux ([]@[a]) as' a'  get_return_edges a
      kind a = Q:rp'fs kind a' = Q'p'f'
    have "same_level_path (a#as'@[a'])"
      by(fastforce intro:same_level_path_aux_Append upd_cs_Append 
                   simp:same_level_path_def)
    from valid_edge a' sourcenode a' = parent_node n3
      targetnode a' = parent_node n4
    have "parent_node n3 -[a']→* parent_node n4" by(fastforce dest:path_edge)
    with ‹parent_node n2 -as'sl* parent_node n3 
    have "parent_node n2 -as'@[a']→* parent_node n4"
      by(fastforce intro:path_Append simp:slp_def)
    with valid_edge a sourcenode a = parent_node n1
      targetnode a = parent_node n2
    have "parent_node n1 -a#as'@[a']→* parent_node n4" by -(rule Cons_path)
    with ‹same_level_path (a#as'@[a'])
    have "parent_node n1 -a#as'@[a']sl* parent_node n4" by(simp add:slp_def)
    with ‹parent_node n0 -assl* parent_node n1
    have "parent_node n0 -as@a#as'@[a']sl* parent_node n4" by(rule slp_Append)
    with sourcenode a = parent_node n1 sourcenode a' = parent_node n3
    show ?case by fastforce
  qed
qed


subsection ‹Realizable paths in the SDG›

inductive realizable :: 
  "'node SDG_node  'node SDG_node list  'node SDG_node  bool"
  where realizable_matched:"matched n ns n'  realizable n ns n'"
  | realizable_call:
  "realizable n0 ns n1; n1 -pcall n2  n1 -p:Vin n2; matched n2 ns' n3
   realizable n0 (ns@n1#ns') n3"


lemma realizable_Append_matched:
  "realizable n ns n''; matched n'' ns' n'  realizable n (ns@ns') n'"
proof(induct rule:realizable.induct)
  case (realizable_matched n ns n'')
  from ‹matched n'' ns' n' ‹matched n ns n'' have "matched n (ns@ns') n'"
    by(rule matched_Append)
  thus ?case by(rule realizable.realizable_matched)
next
  case (realizable_call n0 ns n1 p n2 V ns'' n3)
  from ‹matched n3 ns' n' ‹matched n2 ns'' n3 have "matched n2 (ns''@ns') n'"
    by(rule matched_Append)
  with ‹realizable n0 ns n1 n1 -pcall n2  n1 -p:Vin n2
  have "realizable n0 (ns@n1#(ns''@ns')) n'"
    by(rule realizable.realizable_call)
  thus ?case by simp
qed


lemma realizable_valid_CFG_path:
  assumes "realizable n ns n'" 
  obtains as where "parent_node n -as* parent_node n'"
proof(atomize_elim)
  from ‹realizable n ns n' 
  show "as. parent_node n -as* parent_node n'"
  proof(induct rule:realizable.induct)
    case (realizable_matched n ns n')
    from ‹matched n ns n' obtain as where "parent_node n -assl* parent_node n'"
      by(erule matched_same_level_CFG_path)
    thus ?case by(fastforce intro:slp_vp)
  next
    case (realizable_call n0 ns n1 p n2 V ns' n3)
    from as. parent_node n0 -as* parent_node n1
    obtain as where "parent_node n0 -as* parent_node n1" by blast
    from ‹matched n2 ns' n3 obtain as' where "parent_node n2 -as'sl* parent_node n3"
      by(erule matched_same_level_CFG_path)
    from n1 -pcall n2  n1 -p:Vin n2
    obtain a Q r fs where "valid_edge a"
      and "sourcenode a = parent_node n1" and "targetnode a = parent_node n2"
      and "kind a = Q:rpfs" by(fastforce elim:SDG_edge.cases)+
    hence "parent_node n1 -[a]→* parent_node n2"
      by(fastforce dest:path_edge)
    from ‹parent_node n0 -as* parent_node n1 
    have "parent_node n0 -as→* parent_node n1" and "valid_path as"
      by(simp_all add:vp_def)
    with kind a = Q:rpfs have "valid_path (as@[a])"
      by(fastforce elim:valid_path_aux_Append simp:valid_path_def)
    moreover
    from ‹parent_node n0 -as→* parent_node n1 ‹parent_node n1 -[a]→* parent_node n2
    have "parent_node n0 -as@[a]→* parent_node n2" by(rule path_Append)
    ultimately have "parent_node n0 -as@[a]* parent_node n2" by(simp add:vp_def)
    with ‹parent_node n2 -as'sl* parent_node n3 
    have "parent_node n0 -(as@[a])@as'* parent_node n3" by -(rule vp_slp_Append)
    with sourcenode a = parent_node n1 show ?case by fastforce
  qed
qed


lemma cdep_SDG_path_realizable:
  "n cc-nsd* n'  realizable n ns n'"
proof(induct rule:call_cdep_SDG_path.induct)
  case (ccSp_Nil n)
  from ‹valid_SDG_node n show ?case
    by(fastforce intro:realizable_matched matched_Nil)
next
  case (ccSp_Append_cdep n ns n'' n')
  from n''cd n' have "valid_SDG_node n''" by(rule SDG_edge_valid_SDG_node)
  hence "matched n'' [] n''" by(rule matched_Nil)
  from n''cd n' ‹valid_SDG_node n''
  have "n'' i-[]@[n'']d* n'" 
    by(fastforce intro:iSp_Append_cdep iSp_Nil)
  with ‹matched n'' [] n'' have "matched n'' ([]@[n'']) n'"
    by(fastforce intro:matched_Append_intra_SDG_path)
  with ‹realizable n ns n'' show ?case
    by(fastforce intro:realizable_Append_matched)
next
  case (ccSp_Append_call n ns n'' p n')
  from n'' -pcall n' have "valid_SDG_node n'" by(rule SDG_edge_valid_SDG_node)
  hence "matched n' [] n'" by(rule matched_Nil)
  with ‹realizable n ns n'' n'' -pcall n'
  show ?case by(fastforce intro:realizable_call)
qed


subsection ‹SDG with summary edges›


inductive sum_cdep_edge :: "'node SDG_node  'node SDG_node  bool" 
    ("_ s⟶cd _" [51,0] 80)
  and sum_ddep_edge :: "'node SDG_node  'var  'node SDG_node  bool"
    ("_ s-_dd _" [51,0,0] 80)
  and sum_call_edge :: "'node SDG_node  'pname  'node SDG_node  bool" 
    ("_ s-_call _" [51,0,0] 80)
  and sum_return_edge :: "'node SDG_node  'pname  'node SDG_node  bool" 
    ("_ s-_ret _" [51,0,0] 80)
  and sum_param_in_edge :: "'node SDG_node  'pname  'var  'node SDG_node  bool"
    ("_ s-_:_in _" [51,0,0,0] 80)
  and sum_param_out_edge :: "'node SDG_node  'pname  'var  'node SDG_node  bool"
    ("_ s-_:_out _" [51,0,0,0] 80)
  and sum_summary_edge :: "'node SDG_node  'pname  'node SDG_node  bool" 
    ("_ s-_sum _" [51,0] 80)
  and sum_SDG_edge :: "'node SDG_node  'var option  
                          ('pname × bool) option  bool  'node SDG_node  bool"

where
    (* Syntax *)
  "n s⟶cd n' == sum_SDG_edge n None None False n'"
  | "n s-Vdd n' == sum_SDG_edge n (Some V) None False n'"
  | "n s-pcall n' == sum_SDG_edge n None (Some(p,True)) False n'"
  | "n s-pret n' == sum_SDG_edge n None (Some(p,False)) False n'"
  | "n s-p:Vin n' == sum_SDG_edge n (Some V) (Some(p,True)) False n'"
  | "n s-p:Vout n' == sum_SDG_edge n (Some V) (Some(p,False)) False n'"
  | "n s-psum n' == sum_SDG_edge n None (Some(p,True)) True n'"

    (* Rules *)
  | sum_SDG_cdep_edge:
    "n = CFG_node m; n' = CFG_node m'; m controls m'  n s⟶cd n'"
  | sum_SDG_proc_entry_exit_cdep:
    "valid_edge a; kind a = Q:rpfs; n = CFG_node (targetnode a);
      a'  get_return_edges a; n' = CFG_node (sourcenode a')  n s⟶cd n'"
  | sum_SDG_parent_cdep_edge:
    "valid_SDG_node n'; m = parent_node n'; n = CFG_node m; n  n' 
       n s⟶cd n'"
  | sum_SDG_ddep_edge:"n influences V in n'  n s-Vdd n'"
  | sum_SDG_call_edge:
    "valid_edge a; kind a = Q:rpfs; n = CFG_node (sourcenode a); 
      n' = CFG_node (targetnode a)  n s-pcall n'"
  | sum_SDG_return_edge:
    "valid_edge a; kind a = Qpfs; n = CFG_node (sourcenode a); 
      n' = CFG_node (targetnode a)  n s-pret n'"
  | sum_SDG_param_in_edge:
    "valid_edge a; kind a = Q:rpfs; (p,ins,outs)  set procs; V = ins!x;
      x < length ins; n = Actual_in (sourcenode a,x); n' = Formal_in (targetnode a,x)
       n s-p:Vin n'"
  | sum_SDG_param_out_edge:
    "valid_edge a; kind a = Qpf; (p,ins,outs)  set procs; V = outs!x;
      x < length outs; n = Formal_out (sourcenode a,x); 
      n' = Actual_out (targetnode a,x)
       n s-p:Vout n'"
  | sum_SDG_call_summary_edge:
    "valid_edge a; kind a = Q:rpfs; a'  get_return_edges a; 
      n = CFG_node (sourcenode a); n' = CFG_node (targetnode a')
       n s-psum n'"
  | sum_SDG_param_summary_edge:
    "valid_edge a; kind a = Q:rpfs; a'  get_return_edges a;
      matched (Formal_in (targetnode a,x)) ns (Formal_out (sourcenode a',x'));
      n = Actual_in (sourcenode a,x); n' = Actual_out (targetnode a',x');
      (p,ins,outs)  set procs; x < length ins; x' < length outs
       n s-psum n'"



lemma sum_edge_cases:
  "n s-psum n'; 
    a Q r fs a'. valid_edge a; kind a = Q:rpfs; a'  get_return_edges a;
                n = CFG_node (sourcenode a); n' = CFG_node (targetnode a')  P;
    a Q p r fs a' ns x x' ins outs.
      valid_edge a; kind a = Q:rpfs; a'  get_return_edges a;
       matched (Formal_in (targetnode a,x)) ns (Formal_out (sourcenode a',x'));
       n = Actual_in (sourcenode a,x); n' = Actual_out (targetnode a',x');
       (p,ins,outs)  set procs; x < length ins; x' < length outs  P
   P"
by -(erule sum_SDG_edge.cases,auto)



lemma SDG_edge_sum_SDG_edge:
  "SDG_edge n Vopt popt n'  sum_SDG_edge n Vopt popt False n'"
  by(induct rule:SDG_edge.induct,auto intro:sum_SDG_edge.intros)


lemma sum_SDG_edge_SDG_edge:
  "sum_SDG_edge n Vopt popt False n'  SDG_edge n Vopt popt n'"
by(induct n Vopt popt x"False" n' rule:sum_SDG_edge.induct,
   auto intro:SDG_edge.intros)


lemma sum_SDG_edge_valid_SDG_node:
  assumes "sum_SDG_edge n Vopt popt b n'" 
  shows "valid_SDG_node n" and "valid_SDG_node n'"
proof -
  have "valid_SDG_node n  valid_SDG_node n'"
  proof(cases b)
    case True
    with ‹sum_SDG_edge n Vopt popt b n' show ?thesis
    proof(induct rule:sum_SDG_edge.induct)
      case (sum_SDG_call_summary_edge a Q r p f a' n n')
      from valid_edge a n = CFG_node (sourcenode a)
      have "valid_SDG_node n" by fastforce
      from valid_edge a a'  get_return_edges a have "valid_edge a'"
        by(rule get_return_edges_valid)
      with n' = CFG_node (targetnode a') have "valid_SDG_node n'" by fastforce
      with ‹valid_SDG_node n show ?case by simp
    next
      case (sum_SDG_param_summary_edge a Q r p fs a' x ns x' n n' ins outs)
      from valid_edge a kind a = Q:rpfs n = Actual_in (sourcenode a,x)
        (p,ins,outs)  set procs x < length ins
      have "valid_SDG_node n" by fastforce
      from valid_edge a a'  get_return_edges a have "valid_edge a'"
        by(rule get_return_edges_valid)
      from valid_edge a a'  get_return_edges a kind a = Q:rpfs
      obtain Q' f' where "kind a' = Q'pf'" by(fastforce dest!:call_return_edges)
      with valid_edge a' n' = Actual_out (targetnode a',x')
        (p,ins,outs)  set procs x' < length outs
      have "valid_SDG_node n'" by fastforce
      with ‹valid_SDG_node n show ?case by simp
    qed simp_all
  next
    case False
    with ‹sum_SDG_edge n Vopt popt b n' have "SDG_edge n Vopt popt n'"
      by(fastforce intro:sum_SDG_edge_SDG_edge)
    thus ?thesis by(fastforce intro:SDG_edge_valid_SDG_node)
  qed
  thus "valid_SDG_node n" and "valid_SDG_node n'" by simp_all
qed


lemma Exit_no_sum_SDG_edge_source:
  assumes "sum_SDG_edge (CFG_node (_Exit_)) Vopt popt b n'" shows "False"
proof(cases b)
  case True
  with ‹sum_SDG_edge (CFG_node (_Exit_)) Vopt popt b n' show ?thesis
  proof(induct "CFG_node (_Exit_)" Vopt popt b n' rule:sum_SDG_edge.induct)
    case (sum_SDG_call_summary_edge a Q r p f a' n')
    from ‹CFG_node (_Exit_) = CFG_node (sourcenode a)
    have "sourcenode a = (_Exit_)" by simp
    with valid_edge a show ?case by(rule Exit_source)
  next
    case (sum_SDG_param_summary_edge a Q r p f a' x ns x' n' ins outs)
    thus ?case by simp
  qed simp_all
next
  case False
  with ‹sum_SDG_edge (CFG_node (_Exit_)) Vopt popt b n' 
  have "SDG_edge (CFG_node (_Exit_)) Vopt popt n'"
    by(fastforce intro:sum_SDG_edge_SDG_edge)
  thus ?thesis by(fastforce intro:Exit_no_SDG_edge_source)
qed


lemma Exit_no_sum_SDG_edge_target:
  "sum_SDG_edge n Vopt popt b (CFG_node (_Exit_))  False"
proof(induct "CFG_node (_Exit_)" rule:sum_SDG_edge.induct)
  case (sum_SDG_cdep_edge n m m')
  from m controls m' ‹CFG_node (_Exit_) = CFG_node m'
  have "m controls (_Exit_)" by simp
  hence False by(fastforce dest:Exit_not_control_dependent)
  thus ?case by simp
next
  case (sum_SDG_proc_entry_exit_cdep a Q r p f n a')
  from valid_edge a a'  get_return_edges a have "valid_edge a'"
    by(rule get_return_edges_valid)
  moreover
  from ‹CFG_node (_Exit_) = CFG_node (sourcenode a')
  have "sourcenode a' = (_Exit_)" by simp
  ultimately have False by(rule Exit_source)
  thus ?case by simp
next
  case (sum_SDG_ddep_edge n V) thus ?case
    by(fastforce elim:SDG_Use.cases simp:data_dependence_def)
next
  case (sum_SDG_call_edge a Q r p fs n)
  from ‹CFG_node (_Exit_) = CFG_node (targetnode a)
  have "targetnode a = (_Exit_)" by simp
  with valid_edge a kind a = Q:rpfs have "get_proc (_Exit_) = p"
    by(fastforce intro:get_proc_call)
  hence "p = Main" by(simp add:get_proc_Exit)
  with valid_edge a kind a = Q:rpfs have False 
    by(fastforce intro:Main_no_call_target)
  thus ?case by simp
next
  case (sum_SDG_return_edge a Q p f n)
  from ‹CFG_node (_Exit_) = CFG_node (targetnode a)
  have "targetnode a = (_Exit_)" by simp
  with valid_edge a kind a = Qpf have False by(rule Exit_no_return_target)
  thus ?case by simp
next
  case (sum_SDG_call_summary_edge a Q r p fs a' n)
  from valid_edge a a'  get_return_edges a have "valid_edge a'"
    by(rule get_return_edges_valid)
  from valid_edge a kind a = Q:rpfs a'  get_return_edges a
  obtain Q' f' where "kind a' = Q'pf'" by(fastforce dest!:call_return_edges)
  from ‹CFG_node (_Exit_) = CFG_node (targetnode a')
  have "targetnode a' = (_Exit_)" by simp
  with valid_edge a' kind a' = Q'pf' have False by(rule Exit_no_return_target)
  thus ?case by simp
qed simp+



lemma sum_SDG_summary_edge_matched:
  assumes "n s-psum n'" 
  obtains ns where "matched n ns n'" and "n  set ns"
  and "get_proc (parent_node(last ns)) = p"
proof(atomize_elim)
  from n s-psum n' 
  show "ns. matched n ns n'  n  set ns  get_proc (parent_node(last ns)) = p"
  proof(induct n "None::'var option" "Some(p,True)" "True" n'
               rule:sum_SDG_edge.induct)
    case (sum_SDG_call_summary_edge a Q r fs a' n n')
    from valid_edge a kind a = Q:rpfs n = CFG_node (sourcenode a)
    have "n -pcall CFG_node (targetnode a)" by(fastforce intro:SDG_call_edge)
    hence "valid_SDG_node n" by(rule SDG_edge_valid_SDG_node)
    hence "matched n [] n" by(rule matched_Nil)
    from valid_edge a a'  get_return_edges a have "valid_edge a'"
      by(rule get_return_edges_valid)
    from valid_edge a kind a = Q:rpfs a'  get_return_edges a 
    have matched:"matched (CFG_node (targetnode a)) [CFG_node (targetnode a)]
      (CFG_node (sourcenode a'))" by(rule intra_proc_matched)
    from valid_edge a a'  get_return_edges a kind a = Q:rpfs
    obtain Q' f' where "kind a' = Q'pf'" by(fastforce dest!:call_return_edges)
    with valid_edge a' have "get_proc (sourcenode a') = p" by(rule get_proc_return)
    from valid_edge a' kind a' = Q'pf' n' = CFG_node (targetnode a')
    have "CFG_node (sourcenode a') -pret n'" by(fastforce intro:SDG_return_edge)
    from ‹matched n [] n n -pcall CFG_node (targetnode a) matched
      ‹CFG_node (sourcenode a') -pret n' a'  get_return_edges a
      n = CFG_node (sourcenode a) n' = CFG_node (targetnode a') valid_edge a
    have "matched n ([]@n#[CFG_node (targetnode a)]@[CFG_node (sourcenode a')]) n'"
      by(fastforce intro:matched_bracket_call)
    with get_proc (sourcenode a') = p show ?case by auto
  next
    case (sum_SDG_param_summary_edge a Q r fs a' x ns x' n n' ins outs)
    from valid_edge a kind a = Q:rpfs (p,ins,outs)  set procs
      x < length ins n = Actual_in (sourcenode a,x)
    have "n -p:ins!xin Formal_in (targetnode a,x)" 
      by(fastforce intro:SDG_param_in_edge)
    hence "valid_SDG_node n" by(rule SDG_edge_valid_SDG_node)
    hence "matched n [] n" by(rule matched_Nil)
    from valid_edge a a'  get_return_edges a have "valid_edge a'"
      by(rule get_return_edges_valid)
    from valid_edge a a'  get_return_edges a kind a = Q:rpfs
    obtain Q' f' where "kind a' = Q'pf'" by(fastforce dest!:call_return_edges)
    with valid_edge a' have "get_proc (sourcenode a') = p" by(rule get_proc_return)
    from valid_edge a' kind a' = Q'pf' (p,ins,outs)  set procs
      x' < length outs n' = Actual_out (targetnode a',x')
    have "Formal_out (sourcenode a',x') -p:outs!x'out n'"
      by(fastforce intro:SDG_param_out_edge)
    from ‹matched n [] n n -p:ins!xin Formal_in (targetnode a,x)
      ‹matched (Formal_in (targetnode a,x)) ns (Formal_out (sourcenode a',x'))
      ‹Formal_out (sourcenode a',x') -p:outs!x'out n' 
      a'  get_return_edges a n = Actual_in (sourcenode a,x)
      n' = Actual_out (targetnode a',x') valid_edge a
    have "matched n ([]@n#ns@[Formal_out (sourcenode a',x')]) n'"
      by(fastforce intro:matched_bracket_param)
    with get_proc (sourcenode a') = p show ?case by auto
  qed simp_all
qed


lemma return_edge_determines_call_and_sum_edge:
  assumes "valid_edge a" and "kind a = Qpf"
  obtains a' Q' r' fs' where "a  get_return_edges a'" and "valid_edge a'"
  and "kind a' = Q':r'pfs'" 
  and "CFG_node (sourcenode a') s-psum CFG_node (targetnode a)"
proof(atomize_elim)
  from valid_edge a kind a = Qpf
  have "CFG_node (sourcenode a) s-pret CFG_node (targetnode a)"
    by(fastforce intro:sum_SDG_return_edge)
  from valid_edge a kind a = Qpf
  obtain a' Q' r' fs' where "valid_edge a'" and "kind a' = Q':r'pfs'"
    and "a  get_return_edges a'" by(blast dest:return_needs_call)
  hence "CFG_node (sourcenode a') s-pcall CFG_node (targetnode a')"
    by(fastforce intro:sum_SDG_call_edge)
  from valid_edge a' kind a' = Q':r'pfs' valid_edge a a  get_return_edges a'
  have "CFG_node (targetnode a')cd CFG_node (sourcenode a)"
    by(fastforce intro!:SDG_proc_entry_exit_cdep)
  hence "valid_SDG_node (CFG_node (targetnode a'))"
    by(rule SDG_edge_valid_SDG_node)
  with ‹CFG_node (targetnode a')cd CFG_node (sourcenode a) 
  have "CFG_node (targetnode a') i-[]@[CFG_node (targetnode a')]d* 
        CFG_node (sourcenode a)"
    by(fastforce intro:iSp_Append_cdep iSp_Nil)
  from ‹valid_SDG_node (CFG_node (targetnode a')) 
  have "matched (CFG_node (targetnode a')) [] (CFG_node (targetnode a'))"
    by(rule matched_Nil)
  with ‹CFG_node (targetnode a') i-[]@[CFG_node (targetnode a')]d* 
        CFG_node (sourcenode a)
  have "matched (CFG_node (targetnode a')) ([]@[CFG_node (targetnode a')])
                (CFG_node (sourcenode a))"
    by(fastforce intro:matched_Append_intra_SDG_path)
  with valid_edge a' kind a' = Q':r'pfs' valid_edge a kind a = Qpf
    a  get_return_edges a'
  have "CFG_node (sourcenode a') s-psum CFG_node (targetnode a)"
    by(fastforce intro!:sum_SDG_call_summary_edge)
  with a  get_return_edges a' valid_edge a' kind a' = Q':r'pfs'
  show "a' Q' r' fs'. a  get_return_edges a'  valid_edge a'  
    kind a' = Q':r'pfs'  CFG_node (sourcenode a') s-psum CFG_node (targetnode a)"
    by fastforce
qed
  

subsection ‹Paths consisting of intraprocedural and summary edges in the SDG›

inductive intra_sum_SDG_path ::
  "'node SDG_node  'node SDG_node list  'node SDG_node  bool"
("_ is-_d* _" [51,0,0] 80)
where isSp_Nil:
  "valid_SDG_node n  n is-[]d* n"

  | isSp_Append_cdep:
  "n is-nsd* n''; n'' s⟶cd n'  n is-ns@[n'']d* n'"

  | isSp_Append_ddep:
  "n is-nsd* n''; n'' s-Vdd n'; n''  n'  n is-ns@[n'']d* n'"

  | isSp_Append_sum:
  "n is-nsd* n''; n'' s-psum n'  n is-ns@[n'']d* n'"


lemma is_SDG_path_Append:
  "n'' is-ns'd* n'; n is-nsd* n''  n is-ns@ns'd* n'"
by(induct rule:intra_sum_SDG_path.induct,
   auto intro:intra_sum_SDG_path.intros simp:append_assoc[THEN sym] 
                                        simp del:append_assoc)


lemma is_SDG_path_valid_SDG_node:
  assumes "n is-nsd* n'" shows "valid_SDG_node n" and "valid_SDG_node n'"
using n is-nsd* n'
by(induct rule:intra_sum_SDG_path.induct,
   auto intro:sum_SDG_edge_valid_SDG_node valid_SDG_CFG_node)


lemma intra_SDG_path_is_SDG_path:
  "n i-nsd* n'  n is-nsd* n'"
by(induct rule:intra_SDG_path.induct,
   auto intro:intra_sum_SDG_path.intros SDG_edge_sum_SDG_edge)


lemma is_SDG_path_hd:"n is-nsd* n'; ns  []  hd ns = n"
apply(induct rule:intra_sum_SDG_path.induct) apply clarsimp
by(case_tac ns,auto elim:intra_sum_SDG_path.cases)+


lemma intra_sum_SDG_path_rev_induct [consumes 1, case_names "isSp_Nil" 
  "isSp_Cons_cdep"  "isSp_Cons_ddep"  "isSp_Cons_sum"]: 
  assumes "n is-nsd* n'"
  and refl:"n. valid_SDG_node n  P n [] n"
  and step_cdep:"n ns n' n''. n s⟶cd n''; n'' is-nsd* n'; P n'' ns n' 
                  P n (n#ns) n'"
  and step_ddep:"n ns n' V n''. n s-Vdd n''; n  n''; n'' is-nsd* n'; 
                                  P n'' ns n'  P n (n#ns) n'"
  and step_sum:"n ns n' p n''. n s-psum n''; n'' is-nsd* n'; P n'' ns n' 
                  P n (n#ns) n'"
  shows "P n ns n'"
using n is-nsd* n'
proof(induct ns arbitrary:n)
  case Nil thus ?case by(fastforce elim:intra_sum_SDG_path.cases intro:refl)
next
  case (Cons nx nsx)
  note IH = n. n is-nsxd* n'  P n nsx n'
  from n is-nx#nsxd* n' have [simp]:"n = nx" 
    by(fastforce dest:is_SDG_path_hd)
  from n is-nx#nsxd* n'  have "((n''. n s⟶cd n''  n'' is-nsxd* n') 
    (n'' V. n s-Vdd n''  n  n''  n'' is-nsxd* n')) 
    (n'' p. n s-psum n''  n'' is-nsxd* n')"
  proof(induct nsx arbitrary:n' rule:rev_induct)
    case Nil
    from n is-[nx]d* n' have "n is-[]d* nx" 
      and disj:"nx s⟶cd n'  (V. nx s-Vdd n'  nx  n')  (p. nx s-psum n')"
      by(induct n ns"[nx]" n' rule:intra_sum_SDG_path.induct,auto)
    from n is-[]d* nx have [simp]:"n = nx"
      by(fastforce elim:intra_sum_SDG_path.cases)
    from disj have "valid_SDG_node n'" by(fastforce intro:sum_SDG_edge_valid_SDG_node)
    hence "n' is-[]d* n'" by(rule isSp_Nil)
    with disj show ?case by fastforce
  next
    case (snoc x xs)
    note n'. n is-nx # xsd* n' 
      ((n''. n s⟶cd n''  n'' is-xsd* n') 
      (n'' V. n s-Vdd n''  n  n''  n'' is-xsd* n')) 
      (n'' p. n s-psum n''  n'' is-xsd* n')
    with n is-nx#xs@[x]d* n' show ?case
    proof(induct n "nx#xs@[x]" n' rule:intra_sum_SDG_path.induct)
      case (isSp_Append_cdep m ms m'' n')
      note IH = n'. m is-nx # xsd* n' 
        ((n''. m s⟶cd n''  n'' is-xsd* n') 
        (n'' V. m s-Vdd n''  m  n''  n'' is-xsd* n')) 
        (n'' p. m s-psum n''  n'' is-xsd* n')
      from ms @ [m''] = nx#xs@[x] have [simp]:"ms = nx#xs"
        and [simp]:"m'' = x" by simp_all
      from m is-msd* m'' have "m is-nx#xsd* m''" by simp
      from IH[OF this] obtain n'' where "n'' is-xsd* m''"
        and "(m s⟶cd n''  (V. m s-Vdd n''  m  n''))  (p. m s-psum n'')"
        by fastforce
      from n'' is-xsd* m'' m'' s⟶cd n'
      have "n'' is-xs@[m'']d* n'" by(rule intra_sum_SDG_path.intros)
      with (m s⟶cd n''  (V. m s-Vdd n''  m  n''))  (p. m s-psum n'')
      show ?case by fastforce
    next
      case (isSp_Append_ddep m ms m'' V n')
      note IH = n'. m is-nx # xsd* n' 
        ((n''. m s⟶cd n''  n'' is-xsd* n') 
        (n'' V. m s-Vdd n''  m  n''  n'' is-xsd* n')) 
        (n'' p. m s-psum n''  n'' is-xsd* n')
      from ms @ [m''] = nx#xs@[x] have [simp]:"ms = nx#xs"
        and [simp]:"m'' = x" by simp_all
      from m is-msd* m'' have "m is-nx#xsd* m''" by simp
      from IH[OF this] obtain n'' where "n'' is-xsd* m''"
        and "(m s⟶cd n''  (V. m s-Vdd n''  m  n''))  (p. m s-psum n'')"
        by fastforce
      from n'' is-xsd* m'' m'' s-Vdd n' m''  n'
      have "n'' is-xs@[m'']d* n'" by(rule intra_sum_SDG_path.intros)
      with (m s⟶cd n''  (V. m s-Vdd n''  m  n''))  (p. m s-psum n'')
      show ?case by fastforce
    next
      case (isSp_Append_sum m ms m'' p n')
      note IH = n'. m is-nx # xsd* n' 
        ((n''. m s⟶cd n''  n'' is-xsd* n') 
        (n'' V. m s-Vdd n''  m  n''  n'' is-xsd* n')) 
        (n'' p. m s-psum n''  n'' is-xsd* n')
      from ms @ [m''] = nx#xs@[x] have [simp]:"ms = nx#xs"
        and [simp]:"m'' = x" by simp_all
      from m is-msd* m'' have "m is-nx#xsd* m''" by simp
      from IH[OF this] obtain n'' where "n'' is-xsd* m''"
        and "(m s⟶cd n''  (V. m s-Vdd n''  m  n''))  (p. m s-psum n'')"
        by fastforce
      from n'' is-xsd* m'' m'' s-psum n'
      have "n'' is-xs@[m'']d* n'" by(rule intra_sum_SDG_path.intros)
      with (m s⟶cd n''  (V. m s-Vdd n''  m  n''))  (p. m s-psum n'')
      show ?case by fastforce
    qed
  qed
  thus ?case apply -
  proof(erule disjE)+
    assume "n''. n s⟶cd n''  n'' is-nsxd* n'"
    then obtain n'' where "n s⟶cd n''" and "n'' is-nsxd* n'" by blast
    from IH[OF n'' is-nsxd* n'] have "P n'' nsx n'" .
    from step_cdep[OF n s⟶cd n'' n'' is-nsxd* n' this] show ?thesis by simp
  next
    assume "n'' V. n s-Vdd n''  n  n''  n'' is-nsxd* n'"
    then obtain n'' V where "n s-Vdd n''" and "n  n''" and "n'' is-nsxd* n'" 
      by blast
    from IH[OF n'' is-nsxd* n'] have "P n'' nsx n'" .
    from step_ddep[OF n s-Vdd n'' n  n'' n'' is-nsxd* n' this] 
    show ?thesis by simp
  next
    assume "n'' p. n s-psum n''  n'' is-nsxd* n'"
    then obtain n'' p where "n s-psum n''" and "n'' is-nsxd* n'" by blast
    from IH[OF n'' is-nsxd* n'] have "P n'' nsx n'" .
    from step_sum[OF n s-psum n'' n'' is-nsxd* n' this] show ?thesis by simp
  qed
qed


lemma is_SDG_path_CFG_path:
  assumes "n is-nsd* n'"
  obtains as where "parent_node n -asι* parent_node n'" 
proof(atomize_elim)
  from n is-nsd* n'
  show "as. parent_node n -asι* parent_node n'"
  proof(induct rule:intra_sum_SDG_path.induct)
    case (isSp_Nil n)
    from ‹valid_SDG_node n have "valid_node (parent_node n)"
      by(rule valid_SDG_CFG_node)
    hence "parent_node n -[]→* parent_node n" by(rule empty_path)
    thus ?case by(auto simp:intra_path_def)
  next
    case (isSp_Append_cdep n ns n'' n')
    from as. parent_node n -asι* parent_node n''
    obtain as where "parent_node n -asι* parent_node n''" by blast
    from n'' s⟶cd n'  have "n''cd n'" by(rule sum_SDG_edge_SDG_edge)
    thus ?case
    proof(rule cdep_edge_cases)
      assume "parent_node n'' controls parent_node n'"
      then obtain as' where "parent_node n'' -as'ι* parent_node n'" and "as'  []"
        by(erule control_dependence_path)
      with ‹parent_node n -asι* parent_node n'' 
      have "parent_node n -as@as'ι* parent_node n'" by -(rule intra_path_Append)
      thus ?thesis by blast
    next
      fix a Q r p fs a'
      assume "valid_edge a" and "kind a = Q:rpfs" and "a'  get_return_edges a"
        and "parent_node n'' = targetnode a" and "parent_node n' = sourcenode a'"
      then obtain a'' where "valid_edge a''" and "sourcenode a'' = targetnode a"
        and "targetnode a'' = sourcenode a'" and "kind a'' = (λcf. False)"
        by(auto dest:intra_proc_additional_edge)
      hence "targetnode a -[a'']ι* sourcenode a'"
        by(fastforce dest:path_edge simp:intra_path_def intra_kind_def)
      with ‹parent_node n'' = targetnode a ‹parent_node n' = sourcenode a' 
      have "as'. parent_node n'' -as'ι* parent_node n'  as'  []" by fastforce
      then obtain as' where "parent_node n'' -as'ι* parent_node n'" and "as'  []"
        by blast
      with ‹parent_node n -asι* parent_node n''
      have "parent_node n -as@as'ι* parent_node n'" by -(rule intra_path_Append)
      thus ?thesis by blast
    next
      fix m assume "n'' = CFG_node m" and "m = parent_node n'"
      with ‹parent_node n -asι* parent_node n'' show ?thesis by fastforce
    qed
  next
    case (isSp_Append_ddep n ns n'' V n')
    from as. parent_node n -asι* parent_node n''
    obtain as where "parent_node n -asι* parent_node n''" by blast 
    from n'' s-Vdd n' have "n'' influences V in n'"
      by(fastforce elim:sum_SDG_edge.cases)
    then obtain as' where "parent_node n'' -as'ι* parent_node n'"
      by(auto simp:data_dependence_def)
    with ‹parent_node n -asι* parent_node n'' 
    have "parent_node n -as@as'ι* parent_node n'" by -(rule intra_path_Append)
    thus ?case by blast
  next
    case (isSp_Append_sum n ns n'' p n')
    from as. parent_node n -asι* parent_node n''
    obtain as where "parent_node n -asι* parent_node n''" by blast
    from n'' s-psum n' have "as'. parent_node n'' -as'ι* parent_node n'"
    proof(rule sum_edge_cases)
      fix a Q fs a'
      assume "valid_edge a" and "a'  get_return_edges a"
        and "n'' = CFG_node (sourcenode a)" and "n' = CFG_node (targetnode a')"
      from valid_edge a a'  get_return_edges a
      obtain a'' where "sourcenode a -[a'']ι* targetnode a'"
        apply - apply(drule call_return_node_edge)
        apply(auto simp:intra_path_def) apply(drule path_edge)
        by(auto simp:intra_kind_def)
      with n'' = CFG_node (sourcenode a) n' = CFG_node (targetnode a')
      show ?thesis by simp blast
    next
      fix a Q p fs a' ns x x' ins outs
      assume "valid_edge a" and "a'  get_return_edges a"
        and "n'' = Actual_in (sourcenode a, x)" 
        and "n' = Actual_out (targetnode a', x')"
      from valid_edge a a'  get_return_edges a
      obtain a'' where "sourcenode a -[a'']ι* targetnode a'"
        apply - apply(drule call_return_node_edge)
        apply(auto simp:intra_path_def) apply(drule path_edge)
        by(auto simp:intra_kind_def)
      with n'' = Actual_in (sourcenode a, x) n' = Actual_out (targetnode a', x')
      show ?thesis by simp blast
    qed
    then obtain as' where "parent_node n'' -as'ι* parent_node n'" by blast
    with ‹parent_node n -asι* parent_node n'' 
    have "parent_node n -as@as'ι* parent_node n'" by -(rule intra_path_Append)
    thus ?case by blast
  qed
qed


lemma matched_is_SDG_path:
  assumes "matched n ns n'" obtains ns' where "n is-ns'd* n'"
proof(atomize_elim)
  from ‹matched n ns n' show "ns'. n is-ns'd* n'"
  proof(induct rule:matched.induct)
    case matched_Nil thus ?case by(fastforce intro:isSp_Nil)
  next
    case matched_Append_intra_SDG_path thus ?case
    by(fastforce intro:is_SDG_path_Append intra_SDG_path_is_SDG_path)
  next
    case (matched_bracket_call n0 ns n1 p n2 ns' n3 n4 V a a')
    from ns'. n0 is-ns'd* n1 obtain nsx where "n0 is-nsxd* n1" by blast
    from n1 -pcall n2 sourcenode a = parent_node n1 targetnode a = parent_node n2
    have "n1 = CFG_node (sourcenode a)" and "n2 = CFG_node (targetnode a)"
      by(auto elim:SDG_edge.cases)
    from valid_edge a a'  get_return_edges a
    obtain Q r p' fs where "kind a = Q:rp'fs" 
      by(fastforce dest!:only_call_get_return_edges)
    with n1 -pcall n2 valid_edge a
      n1 = CFG_node (sourcenode a) n2 = CFG_node (targetnode a)
    have [simp]:"p' = p" by -(erule SDG_edge.cases,(fastforce dest:edge_det)+)
    from valid_edge a a'  get_return_edges a have "valid_edge a'"
      by(rule get_return_edges_valid)
    from n3 -pret n4  n3 -p:Vout n4 show ?case
    proof
      assume "n3 -pret n4"
      then obtain ax Q' f' where "valid_edge ax" and "kind ax = Q'pf'"
        and "n3 = CFG_node (sourcenode ax)" and "n4 = CFG_node (targetnode ax)"
        by(fastforce elim:SDG_edge.cases)
      with sourcenode a' = parent_node n3 targetnode a' = parent_node n4 
        valid_edge a' have [simp]:"ax = a'" by(fastforce dest:edge_det)
      from valid_edge a kind a = Q:rp'fs valid_edge ax kind ax = Q'pf'
        a'  get_return_edges a ‹matched n2 ns' n3
        n1 = CFG_node (sourcenode a) n2 = CFG_node (targetnode a)
        n3 = CFG_node (sourcenode ax) n4 = CFG_node (targetnode ax)
      have "n1 s-psum n4" 
        by(fastforce intro!:sum_SDG_call_summary_edge[of a _ _ _ _ ax])
      with n0 is-nsxd* n1 have "n0 is-nsx@[n1]d* n4" by(rule isSp_Append_sum)
      thus ?case by blast
    next
      assume "n3 -p:Vout n4"
      then obtain ax Q' f' x where "valid_edge ax" and "kind ax = Q'pf'"
        and "n3 = Formal_out (sourcenode ax,x)" 
        and "n4 = Actual_out (targetnode ax,x)"
        by(fastforce elim:SDG_edge.cases)
      with sourcenode a' = parent_node n3 targetnode a' = parent_node n4 
        valid_edge a' have [simp]:"ax = a'" by(fastforce dest:edge_det)
      from valid_edge ax kind ax = Q'pf' n3 = Formal_out (sourcenode ax,x)
        n4 = Actual_out (targetnode ax,x)
      have "CFG_node (sourcenode a') -pret CFG_node (targetnode a')"
        by(fastforce intro:SDG_return_edge)
      from valid_edge a kind a = Q:rp'fs valid_edge a' 
        a'  get_return_edges a n4 = Actual_out (targetnode ax,x)
      have "CFG_node (targetnode a)cd CFG_node (sourcenode a')"
        by(fastforce intro!:SDG_proc_entry_exit_cdep)
      with n2 = CFG_node (targetnode a)
      have "matched n2 ([]@([]@[n2])) (CFG_node (sourcenode a'))"
        by(fastforce intro:matched.intros intra_SDG_path.intros 
                          SDG_edge_valid_SDG_node) 
      with valid_edge a kind a = Q:rp'fs valid_edge a' kind ax = Q'pf'
        a'  get_return_edges a n1 = CFG_node (sourcenode a) 
        n2 = CFG_node (targetnode a) n4 = Actual_out (targetnode ax,x)
      have "n1 s-psum CFG_node (targetnode a')"
        by(fastforce intro!:sum_SDG_call_summary_edge[of a _ _ _ _ a'])
      with n0 is-nsxd* n1 have "n0 is-nsx@[n1]d* CFG_node (targetnode a')"
        by(rule isSp_Append_sum)
      from n4 = Actual_out (targetnode ax,x) n3 -p:Vout n4
      have "CFG_node (targetnode a') s⟶cd n4"
        by(fastforce intro:sum_SDG_parent_cdep_edge SDG_edge_valid_SDG_node)
      with n0 is-nsx@[n1]d* CFG_node (targetnode a')
      have "n0 is-(nsx@[n1])@[CFG_node (targetnode a')]d* n4"
        by(rule isSp_Append_cdep)
      thus ?case by blast
    qed
  next
    case (matched_bracket_param n0 ns n1 p V n2 ns' n3 V' n4 a a')
    from ns'. n0 is-ns'd* n1 obtain nsx where "n0 is-nsxd* n1" by blast
    from n1 -p:Vin n2 sourcenode a = parent_node n1
      targetnode a = parent_node n2 obtain x ins outs
      where "n1 = Actual_in (sourcenode a,x)" and "n2 = Formal_in (targetnode a,x)"
      and "(p,ins,outs)  set procs" and "V = ins!x" and "x < length ins"
      by(fastforce elim:SDG_edge.cases)
    from valid_edge a a'  get_return_edges a
    obtain Q r p' fs where "kind a = Q:rp'fs"
      by(fastforce dest!:only_call_get_return_edges)
    with n1 -p:Vin n2 valid_edge a
      n1 = Actual_in (sourcenode a,x) n2 = Formal_in (targetnode a,x)
    have [simp]:"p' = p" by -(erule SDG_edge.cases,(fastforce dest:edge_det)+)
    from valid_edge a a'  get_return_edges a have "valid_edge a'"
      by(rule get_return_edges_valid)
    from n3 -p:V'out n4 obtain ax Q' f' x' ins' outs' where "valid_edge ax" 
      and "kind ax = Q'pf'" and "n3 = Formal_out (sourcenode ax,x')" 
      and "n4 = Actual_out (targetnode ax,x')" and "(p,ins',outs')  set procs"
      and "V' = outs'!x'" and "x' < length outs'"
      by(fastforce elim:SDG_edge.cases)
    with sourcenode a' = parent_node n3 targetnode a' = parent_node n4
      valid_edge a' have [simp]:"ax = a'" by(fastforce dest:edge_det)
    from unique_callers (p,ins,outs)  set procs (p,ins',outs')  set procs
    have [simp]:"ins = ins'" "outs = outs'"
      by(auto dest:distinct_fst_isin_same_fst)
    from valid_edge a kind a = Q:rp'fs valid_edge a' kind ax = Q'pf'
      a'  get_return_edges a ‹matched n2 ns' n3 n1 = Actual_in (sourcenode a,x) 
      n2 = Formal_in (targetnode a,x) n3 = Formal_out (sourcenode ax,x')
      n4 = Actual_out (targetnode ax,x') (p,ins,outs)  set procs
      x < length ins x' < length outs' V = ins!x V' = outs'!x'
    have "n1 s-psum n4" 
      by(fastforce intro!:sum_SDG_param_summary_edge[of a _ _ _ _ a'])
    with n0 is-nsxd* n1 have "n0 is-nsx@[n1]d* n4" by(rule isSp_Append_sum)
    thus ?case by blast
  qed
qed


lemma is_SDG_path_matched:
  assumes "n is-nsd* n'" obtains ns' where "matched n ns' n'" and "set ns  set ns'"
proof(atomize_elim)
  from n is-nsd* n' show "ns'. matched n ns' n'  set ns  set ns'"
  proof(induct rule:intra_sum_SDG_path.induct)
    case (isSp_Nil n)
    from ‹valid_SDG_node n have "matched n [] n" by(rule matched_Nil)
    thus ?case by fastforce
  next
    case (isSp_Append_cdep n ns n'' n')
    from ns'. matched n ns' n''  set ns  set ns'
    obtain ns' where "matched n ns' n''" and "set ns  set ns'" by blast
    from n'' s⟶cd n' have "n'' i-[]@[n'']d* n'"
      by(fastforce intro:intra_SDG_path.intros sum_SDG_edge_valid_SDG_node 
                        sum_SDG_edge_SDG_edge)
    with ‹matched n ns' n'' have "matched n (ns'@[n'']) n'"
      by(fastforce intro!:matched_Append_intra_SDG_path)
    with ‹set ns  set ns' show ?case by fastforce
  next
    case (isSp_Append_ddep n ns n'' V n')
    from ns'. matched n ns' n''  set ns  set ns'
    obtain ns' where "matched n ns' n''" and "set ns  set ns'" by blast
    from n'' s-Vdd n' n''  n' have "n'' i-[]@[n'']d* n'"
      by(fastforce intro:intra_SDG_path.intros sum_SDG_edge_valid_SDG_node 
                        sum_SDG_edge_SDG_edge)
    with ‹matched n ns' n'' have "matched n (ns'@[n'']) n'"
      by(fastforce intro!:matched_Append_intra_SDG_path)
    with ‹set ns  set ns' show ?case by fastforce
  next
    case (isSp_Append_sum n ns n'' p n')
    from ns'. matched n ns' n''  set ns  set ns'
    obtain ns' where "matched n ns' n''" and "set ns  set ns'" by blast
    from n'' s-psum n' obtain ns'' where "matched n'' ns'' n'" and "n''  set ns''"
      by -(erule sum_SDG_summary_edge_matched)
    with ‹matched n ns' n'' have "matched n (ns'@ns'') n'" by -(rule matched_Append)
    with ‹set ns  set ns' n''  set ns'' show ?case by fastforce
  qed
qed


lemma is_SDG_path_intra_CFG_path:
  assumes "n is-nsd* n'"
  obtains as where "parent_node n -asι* parent_node n'" 
proof(atomize_elim)
  from n is-nsd* n'
  show "as. parent_node n -asι* parent_node n'"
  proof(induct rule:intra_sum_SDG_path.induct)
    case (isSp_Nil n)
    from ‹valid_SDG_node n have "parent_node n -[]→* parent_node n"
      by(fastforce intro:empty_path valid_SDG_CFG_node)
    thus ?case by(auto simp:intra_path_def)
  next
    case (isSp_Append_cdep n ns n'' n')
    from as. parent_node n -asι* parent_node n''
    obtain as where "parent_node n -asι* parent_node n''" by blast
    from n'' s⟶cd n' have "n''cd n'" by(rule sum_SDG_edge_SDG_edge)
    thus ?case
    proof(rule cdep_edge_cases)
      assume "parent_node n'' controls parent_node n'"
      then obtain as' where "parent_node n'' -as'ι* parent_node n'" and "as'  []"
        by(erule control_dependence_path)
      with ‹parent_node n -asι* parent_node n'' 
      have "parent_node n -as@as'ι* parent_node n'" by -(rule intra_path_Append)
      thus ?thesis by blast
    next
      fix a Q r p fs a'
      assume "valid_edge a" and "kind a = Q:rpfs" "a'  get_return_edges a"
        and "parent_node n'' = targetnode a" and "parent_node n' = sourcenode a'"
      then obtain a'' where "valid_edge a''" and "sourcenode a'' = targetnode a"
        and "targetnode a'' = sourcenode a'" and "kind a'' = (λcf. False)"
        by(auto dest:intra_proc_additional_edge)
      hence "targetnode a -[a'']ι* sourcenode a'"
        by(fastforce dest:path_edge simp:intra_path_def intra_kind_def)
      with ‹parent_node n'' = targetnode a ‹parent_node n' = sourcenode a' 
      have "as'. parent_node n'' -as'ι* parent_node n'  as'  []" by fastforce
      then obtain as' where "parent_node n'' -as'ι* parent_node n'" and "as'  []"
        by blast
      with ‹parent_node n -asι* parent_node n'' 
      have "parent_node n -as@as'ι* parent_node n'" by -(rule intra_path_Append)
      thus ?thesis by blast
    next
      fix m assume "n'' = CFG_node m" and "m = parent_node n'"
      with ‹parent_node n -asι* parent_node n'' show ?thesis by fastforce
    qed
  next
    case (isSp_Append_ddep n ns n'' V n')
    from as. parent_node n -asι* parent_node n''
    obtain as where "parent_node n -asι* parent_node n''"  by blast
    from n'' s-Vdd n' have "n'' influences V in n'"
      by(fastforce elim:sum_SDG_edge.cases)
    then obtain as' where "parent_node n'' -as'ι* parent_node n'"
      by(auto simp:data_dependence_def)
    with ‹parent_node n -asι* parent_node n'' 
    have "parent_node n -as@as'ι* parent_node n'" by -(rule intra_path_Append)
    thus ?case by blast
  next
    case (isSp_Append_sum n ns n'' p n')
    from as. parent_node n -asι* parent_node n''
    obtain as where "parent_node n -asι* parent_node n''"  by blast
    from n'' s-psum n' obtain ns' where "matched n'' ns' n'"
      by -(erule sum_SDG_summary_edge_matched)
    then obtain as' where "parent_node n'' -as'ι* parent_node n'"
      by(erule matched_intra_CFG_path)
    with ‹parent_node n -asι* parent_node n'' 
    have "parent_node n -as@as'ι* parent_node n'"
      by(fastforce intro:path_Append simp:intra_path_def)
    thus ?case by blast
  qed
qed


text ‹SDG paths without return edges›

inductive intra_call_sum_SDG_path ::
  "'node SDG_node  'node SDG_node list  'node SDG_node  bool"
("_ ics-_d* _" [51,0,0] 80)
where icsSp_Nil:
  "valid_SDG_node n  n ics-[]d* n"

  | icsSp_Append_cdep:
  "n ics-nsd* n''; n'' s⟶cd n'  n ics-ns@[n'']d* n'"

  | icsSp_Append_ddep:
  "n ics-nsd* n''; n'' s-Vdd n'; n''  n'  n ics-ns@[n'']d* n'"

  | icsSp_Append_sum:
  "n ics-nsd* n''; n'' s-psum n'  n ics-ns@[n'']d* n'"

  | icsSp_Append_call:
  "n ics-nsd* n''; n'' s-pcall n'  n ics-ns@[n'']d* n'"

  | icsSp_Append_param_in:
  "n ics-nsd* n''; n'' s-p:Vin n'  n ics-ns@[n'']d* n'"


lemma ics_SDG_path_valid_SDG_node:
  assumes "n ics-nsd* n'" shows "valid_SDG_node n" and "valid_SDG_node n'"
using n ics-nsd* n'
by(induct rule:intra_call_sum_SDG_path.induct,
   auto intro:sum_SDG_edge_valid_SDG_node valid_SDG_CFG_node)


lemma ics_SDG_path_Append:
  "n'' ics-ns'd* n'; n ics-nsd* n''  n ics-ns@ns'd* n'"
by(induct rule:intra_call_sum_SDG_path.induct,
   auto intro:intra_call_sum_SDG_path.intros simp:append_assoc[THEN sym] 
                                        simp del:append_assoc)


lemma is_SDG_path_ics_SDG_path:
  "n is-nsd* n'  n ics-nsd* n'"
by(induct rule:intra_sum_SDG_path.induct,auto intro:intra_call_sum_SDG_path.intros)


lemma cc_SDG_path_ics_SDG_path:
  "n cc-nsd* n'  n ics-nsd* n'"
by(induct rule:call_cdep_SDG_path.induct,
  auto intro:intra_call_sum_SDG_path.intros SDG_edge_sum_SDG_edge)


lemma ics_SDG_path_split:
  assumes "n ics-nsd* n'" and "n''  set ns" 
  obtains ns' ns'' where "ns = ns'@ns''" and "n ics-ns'd* n''" 
  and "n'' ics-ns''d* n'"
proof(atomize_elim)
  from n ics-nsd* n' n''  set ns
  show "ns' ns''. ns = ns'@ns''  n ics-ns'd* n''  n'' ics-ns''d* n'"
  proof(induct rule:intra_call_sum_SDG_path.induct)
    case icsSp_Nil thus ?case by simp
  next
    case (icsSp_Append_cdep n ns nx n')
    note IH = n''  set ns 
      ns' ns''. ns = ns' @ ns''  n ics-ns'd* n''  n'' ics-ns''d* nx
    from n''  set (ns@[nx]) have "n''  set ns  n'' = nx" by fastforce
    thus ?case
    proof
      assume "n''  set ns"
      from IH[OF this] obtain ns' ns'' where "ns = ns' @ ns''"
        and "n ics-ns'd* n''" and "n'' ics-ns''d* nx" by blast
      from n'' ics-ns''d* nx nx s⟶cd n'
      have "n'' ics-ns''@[nx]d* n'"
        by(rule intra_call_sum_SDG_path.icsSp_Append_cdep)
      with ns = ns'@ns'' n ics-ns'd* n'' show ?thesis by fastforce
    next
      assume "n'' = nx"
      from nx s⟶cd n' have "nx ics-[]d* nx"
        by(fastforce intro:icsSp_Nil SDG_edge_valid_SDG_node sum_SDG_edge_SDG_edge)
      with nx s⟶cd n' have "nx ics-[]@[nx]d* n'"
        by -(rule intra_call_sum_SDG_path.icsSp_Append_cdep)
      with n ics-nsd* nx n'' = nx show ?thesis by fastforce
    qed
  next
    case (icsSp_Append_ddep n ns nx V n')
    note IH = n''  set ns 
      ns' ns''. ns = ns' @ ns''  n ics-ns'd* n''  n'' ics-ns''d* nx
    from n''  set (ns@[nx]) have "n''  set ns  n'' = nx" by fastforce
    thus ?case
    proof
      assume "n''  set ns"
      from IH[OF this] obtain ns' ns'' where "ns = ns' @ ns''"
        and "n ics-ns'd* n''" and "n'' ics-ns''d* nx" by blast
      from n'' ics-ns''d* nx nx s-Vdd n' nx  n'
      have "n'' ics-ns''@[nx]d* n'"
        by(rule intra_call_sum_SDG_path.icsSp_Append_ddep)
      with ns = ns'@ns'' n ics-ns'd* n'' show ?thesis by fastforce
    next
      assume "n'' = nx"
      from nx s-Vdd n' have "nx ics-[]d* nx"
        by(fastforce intro:icsSp_Nil SDG_edge_valid_SDG_node sum_SDG_edge_SDG_edge)
      with nx s-Vdd n' nx  n' have "nx ics-[]@[nx]d* n'"
        by -(rule intra_call_sum_SDG_path.icsSp_Append_ddep)
      with n ics-nsd* nx n'' = nx show ?thesis by fastforce
    qed
  next
    case (icsSp_Append_sum n ns nx p n')
    note IH = n''  set ns 
      ns' ns''. ns = ns' @ ns''  n ics-ns'd* n''  n'' ics-ns''d* nx
    from n''  set (ns@[nx]) have "n''  set ns  n'' = nx" by fastforce
    thus ?case
    proof
      assume "n''  set ns"
      from IH[OF this] obtain ns' ns'' where "ns = ns' @ ns''"
        and "n ics-ns'd* n''" and "n'' ics-ns''d* nx" by blast
      from n'' ics-ns''d* nx nx s-psum n'
      have "n'' ics-ns''@[nx]d* n'"
        by(rule intra_call_sum_SDG_path.icsSp_Append_sum)
      with ns = ns'@ns'' n ics-ns'd* n'' show ?thesis by fastforce
    next
      assume "n'' = nx"
      from nx s-psum n' have "valid_SDG_node nx"
        by(fastforce elim:sum_SDG_edge.cases)
      hence "nx ics-[]d* nx" by(fastforce intro:icsSp_Nil)
      with nx s-psum n' have "nx ics-[]@[nx]d* n'"
        by -(rule intra_call_sum_SDG_path.icsSp_Append_sum)
      with n ics-nsd* nx n'' = nx show ?thesis by fastforce
    qed
  next
    case (icsSp_Append_call n ns nx p n')
    note IH = n''  set ns 
      ns' ns''. ns = ns' @ ns''  n ics-ns'd* n''  n'' ics-ns''d* nx
    from n''  set (ns@[nx]) have "n''  set ns  n'' = nx" by fastforce
    thus ?case
    proof
      assume "n''  set ns"
      from IH[OF this] obtain ns' ns'' where "ns = ns' @ ns''"
        and "n ics-ns'd* n''" and "n'' ics-ns''d* nx" by blast
      from n'' ics-ns''d* nx nx s-pcall n'
      have "n'' ics-ns''@[nx]d* n'"
        by(rule intra_call_sum_SDG_path.icsSp_Append_call)
      with ns = ns'@ns'' n ics-ns'd* n'' show ?thesis by fastforce
    next
      assume "n'' = nx"
      from nx s-pcall n' have "nx ics-[]d* nx"
        by(fastforce intro:icsSp_Nil SDG_edge_valid_SDG_node sum_SDG_edge_SDG_edge)
      with nx s-pcall n' have "nx ics-[]@[nx]d* n'"
        by -(rule intra_call_sum_SDG_path.icsSp_Append_call)
      with n ics-nsd* nx n'' = nx show ?thesis by fastforce
    qed
  next
    case (icsSp_Append_param_in n ns nx p V n')
    note IH = n''  set ns 
      ns' ns''. ns = ns' @ ns''  n ics-ns'd* n''  n'' ics-ns''d* nx
    from n''  set (ns@[nx]) have "n''  set ns  n'' = nx" by fastforce
    thus ?case
    proof
      assume "n''  set ns"
      from IH[OF this] obtain ns' ns'' where "ns = ns' @ ns''"
        and "n ics-ns'd* n''" and "n'' ics-ns''d* nx" by blast
      from n'' ics-ns''d* nx nx s-p:Vin n'
      have "n'' ics-ns''@[nx]d* n'"
        by(rule intra_call_sum_SDG_path.icsSp_Append_param_in)
      with ns = ns'@ns'' n ics-ns'd* n'' show ?thesis by fastforce
    next
      assume "n'' = nx"
      from nx s-p:Vin n' have "nx ics-[]d* nx"
        by(fastforce intro:icsSp_Nil SDG_edge_valid_SDG_node sum_SDG_edge_SDG_edge)
      with nx s-p:Vin n' have "nx ics-[]@[nx]d* n'"
        by -(rule intra_call_sum_SDG_path.icsSp_Append_param_in)
      with n ics-nsd* nx n'' = nx show ?thesis by fastforce
    qed
  qed
qed


lemma realizable_ics_SDG_path:
  assumes "realizable n ns n'" obtains ns' where "n ics-ns'd* n'"
proof(atomize_elim)
  from ‹realizable n ns n' show "ns'. n ics-ns'd* n'"
  proof(induct rule:realizable.induct)
    case (realizable_matched n ns n')
    from ‹matched n ns n' obtain ns' where "n is-ns'd* n'"
      by(erule matched_is_SDG_path)
    thus ?case by(fastforce intro:is_SDG_path_ics_SDG_path)
  next
    case (realizable_call n0 ns n1 p n2 V ns' n3)
    from ns'. n0 ics-ns'd* n1 obtain nsx where "n0 ics-nsxd* n1" by blast
    with n1 -pcall n2  n1 -p:Vin n2 have "n0 ics-nsx@[n1]d* n2"
      by(fastforce intro:SDG_edge_sum_SDG_edge icsSp_Append_call icsSp_Append_param_in)
    from ‹matched n2 ns' n3 obtain nsx' where "n2 is-nsx'd* n3"
      by(erule matched_is_SDG_path)
    hence "n2 ics-nsx'd* n3" by(rule is_SDG_path_ics_SDG_path)
    from n2 ics-nsx'd* n3 n0 ics-nsx@[n1]d* n2
    have "n0 ics-(nsx@[n1])@nsx'd* n3" by(rule ics_SDG_path_Append)
    thus ?case by blast
  qed
qed


lemma ics_SDG_path_realizable:
  assumes "n ics-nsd* n'" 
  obtains ns' where "realizable n ns' n'" and "set ns  set ns'"
proof(atomize_elim)
  from n ics-nsd* n' show "ns'. realizable n ns' n'  set ns  set ns'"
  proof(induct rule:intra_call_sum_SDG_path.induct)
    case (icsSp_Nil n)
    hence "matched n [] n" by(rule matched_Nil)
    thus ?case by(fastforce intro:realizable_matched)
  next
    case (icsSp_Append_cdep n ns n'' n')
    from ns'. realizable n ns' n''  set ns  set ns'
    obtain ns' where "realizable n ns' n''" and "set ns  set ns'" by blast
    from n'' s⟶cd n' have "valid_SDG_node n''" by(rule sum_SDG_edge_valid_SDG_node)
    hence "n'' i-[]d* n''" by(rule iSp_Nil)
    with n'' s⟶cd n' have "n'' i-[]@[n'']d* n'"
      by(fastforce elim:iSp_Append_cdep sum_SDG_edge_SDG_edge)
    hence "matched n'' [n''] n'" by(fastforce intro:intra_SDG_path_matched)
    with ‹realizable n ns' n'' have "realizable n (ns'@[n'']) n'"
      by(rule realizable_Append_matched)
    with ‹set ns  set ns' show ?case by fastforce
  next
    case (icsSp_Append_ddep n ns n'' V n')
    from ns'. realizable n ns' n''  set ns  set ns'
    obtain ns' where "realizable n ns' n''" and "set ns  set ns'" by blast
    from n'' s-Vdd n' have "valid_SDG_node n''"
      by(rule sum_SDG_edge_valid_SDG_node)
    hence "n'' i-[]d* n''" by(rule iSp_Nil)
    with n'' s-Vdd n' n''  n' have "n'' i-[]@[n'']d* n'"
      by(fastforce elim:iSp_Append_ddep sum_SDG_edge_SDG_edge)
    hence "matched n'' [n''] n'" by(fastforce intro:intra_SDG_path_matched)
    with ‹realizable n ns' n'' have "realizable n (ns'@[n'']) n'"
      by(fastforce intro:realizable_Append_matched)
    with ‹set ns  set ns' show ?case by fastforce
  next
    case (icsSp_Append_sum n ns n'' p n')
    from ns'. realizable n ns' n''  set ns  set ns'
    obtain ns' where "realizable n ns' n''" and "set ns  set ns'" by blast
    from n'' s-psum n' show ?case
    proof(rule sum_edge_cases)
      fix a Q r fs a'
      assume "valid_edge a" and "kind a = Q:rpfs" and "a'  get_return_edges a"
        and "n'' = CFG_node (sourcenode a)" and "n' = CFG_node (targetnode a')"
      from valid_edge a kind a = Q:rpfs a'  get_return_edges a
      have match':"matched (CFG_node (targetnode a)) [CFG_node (targetnode a)]
        (CFG_node (sourcenode a'))"
        by(rule intra_proc_matched)
      from valid_edge a kind a = Q:rpfs n'' = CFG_node (sourcenode a)
      have "n'' -pcall CFG_node (targetnode a)"
        by(fastforce intro:SDG_call_edge)
      hence "matched n'' [] n''"
        by(fastforce intro:matched_Nil SDG_edge_valid_SDG_node)
      from valid_edge a a'  get_return_edges a have "valid_edge a'"
        by(rule get_return_edges_valid)
      from valid_edge a kind a = Q:rpfs a'  get_return_edges a
      obtain Q' f' where "kind a' = Q'pf'" by(fastforce dest!:call_return_edges)
      from valid_edge a' kind a' = Q'pf' n' = CFG_node (targetnode a')
      have "CFG_node (sourcenode a') -pret n'"
        by(fastforce intro:SDG_return_edge)
      from ‹matched n'' [] n'' n'' -pcall CFG_node (targetnode a)
        match' ‹CFG_node (sourcenode a') -pret n' valid_edge a 
        a'  get_return_edges a n' = CFG_node (targetnode a') 
        n'' = CFG_node (sourcenode a)
      have "matched n'' ([]@n''#[CFG_node (targetnode a)]@[CFG_node (sourcenode a')])
        n'"
        by(fastforce intro:matched_bracket_call)
      with ‹realizable n ns' n''
      have "realizable n 
        (ns'@(n''#[CFG_node (targetnode a),CFG_node (sourcenode a')])) n'"
        by(fastforce intro:realizable_Append_matched)
      with ‹set ns  set ns' show ?thesis by fastforce
    next
      fix a Q r p fs a' ns'' x x' ins outs
      assume "valid_edge a" and "kind a = Q:rpfs" and "a'  get_return_edges a"
        and match':"matched (Formal_in (targetnode a,x)) ns'' 
                            (Formal_out (sourcenode a',x'))"
        and "n'' = Actual_in (sourcenode a,x)" 
        and "n' = Actual_out (targetnode a',x')" and "(p,ins,outs)  set procs" 
        and "x < length ins" and "x' < length outs"
      from valid_edge a kind a = Q:rpfs n'' = Actual_in (sourcenode a,x)
        (p,ins,outs)  set procs x < length ins
      have "n'' -p:ins!xin Formal_in (targetnode a,x)"
        by(fastforce intro!:SDG_param_in_edge)
      hence "matched n'' [] n''" 
        by(fastforce intro:matched_Nil SDG_edge_valid_SDG_node)
      from valid_edge a a'  get_return_edges a have "valid_edge a'"
        by(rule get_return_edges_valid)
      from valid_edge a kind a = Q:rpfs a'  get_return_edges a
      obtain Q' f' where "kind a' = Q'pf'" by(fastforce dest!:call_return_edges)
      from valid_edge a' kind a' = Q'pf' n' = Actual_out (targetnode a',x')
        (p,ins,outs)  set procs x' < length outs
      have "Formal_out (sourcenode a',x') -p:outs!x'out n'"
        by(fastforce intro:SDG_param_out_edge)
      from ‹matched n'' [] n'' n'' -p:ins!xin Formal_in (targetnode a,x)
        match' ‹Formal_out (sourcenode a',x') -p:outs!x'out n' valid_edge a 
        a'  get_return_edges a n' = Actual_out (targetnode a',x')
        n'' = Actual_in (sourcenode a,x)
      have "matched n'' ([]@n''#ns''@[Formal_out (sourcenode a',x')]) n'"
        by(fastforce intro:matched_bracket_param)
      with ‹realizable n ns' n''
      have "realizable n (ns'@(n''#ns''@[Formal_out (sourcenode a',x')])) n'"
        by(fastforce intro:realizable_Append_matched)
      with ‹set ns  set ns' show ?thesis by fastforce
    qed
  next
    case (icsSp_Append_call n ns n'' p n')
    from ns'. realizable n ns' n''  set ns  set ns'
    obtain ns' where "realizable n ns' n''" and "set ns  set ns'" by blast
    from n'' s-pcall n' have "valid_SDG_node n'"
      by(rule sum_SDG_edge_valid_SDG_node)
    hence "matched n' [] n'" by(rule matched_Nil)
    with ‹realizable n ns' n'' n'' s-pcall n'
    have "realizable n (ns'@n''#[]) n'"
      by(fastforce intro:realizable_call sum_SDG_edge_SDG_edge)
    with ‹set ns  set ns' show ?case by fastforce
  next
    case (icsSp_Append_param_in n ns n'' p V n')
    from ns'. realizable n ns' n''  set ns  set ns'
    obtain ns' where "realizable n ns' n''" and "set ns  set ns'" by blast
    from n'' s-p:Vin n' have "valid_SDG_node n'"
      by(rule sum_SDG_edge_valid_SDG_node)
    hence "matched n' [] n'" by(rule matched_Nil)
    with ‹realizable n ns' n'' n'' s-p:Vin n'
    have "realizable n (ns'@n''#[]) n'"
      by(fastforce intro:realizable_call sum_SDG_edge_SDG_edge)
    with ‹set ns  set ns' show ?case by fastforce
  qed
qed



lemma realizable_Append_ics_SDG_path:
  assumes "realizable n ns n''" and "n'' ics-ns'd* n'"
  obtains ns'' where "realizable n (ns@ns'') n'"
proof(atomize_elim)
  from n'' ics-ns'd* n' ‹realizable n ns n''
  show "ns''. realizable n (ns@ns'') n'"
  proof(induct rule:intra_call_sum_SDG_path.induct)
    case (icsSp_Nil n'') thus ?case by(rule_tac x="[]" in exI) fastforce
  next
    case (icsSp_Append_cdep n'' ns' nx n')
    then obtain ns'' where "realizable n (ns@ns'') nx" by fastforce
    from nx s⟶cd n' have "valid_SDG_node nx" by(rule sum_SDG_edge_valid_SDG_node)
    hence "matched nx [] nx" by(rule matched_Nil)
    from nx s⟶cd n' ‹valid_SDG_node nx
    have "nx i-[]@[nx]d* n'" 
      by(fastforce intro:iSp_Append_cdep iSp_Nil sum_SDG_edge_SDG_edge)
    with ‹matched nx [] nx have "matched nx ([]@[nx]) n'"
      by(fastforce intro:matched_Append_intra_SDG_path)
    with ‹realizable n (ns@ns'') nx have "realizable n ((ns@ns'')@[nx]) n'"
      by(fastforce intro:realizable_Append_matched)
    thus ?case by fastforce
  next
    case (icsSp_Append_ddep n'' ns' nx V n')
    then obtain ns'' where "realizable n (ns@ns'') nx" by fastforce
    from nx s-Vdd n' have "valid_SDG_node nx" by(rule sum_SDG_edge_valid_SDG_node)
    hence "matched nx [] nx" by(rule matched_Nil)
    from nx s-Vdd n' nx  n' ‹valid_SDG_node nx
    have "nx i-[]@[nx]d* n'" 
      by(fastforce intro:iSp_Append_ddep iSp_Nil sum_SDG_edge_SDG_edge)
    with ‹matched nx [] nx have "matched nx ([]@[nx]) n'"
      by(fastforce intro:matched_Append_intra_SDG_path)
    with ‹realizable n (ns@ns'') nx have "realizable n ((ns@ns'')@[nx]) n'"
      by(fastforce intro:realizable_Append_matched)
    thus ?case by fastforce
  next
    case (icsSp_Append_sum n'' ns' nx p n')
    then obtain ns'' where "realizable n (ns@ns'') nx" by fastforce
    from nx s-psum n' obtain nsx where "matched nx nsx n'"
      by -(erule sum_SDG_summary_edge_matched)
    with ‹realizable n (ns@ns'') nx have "realizable n ((ns@ns'')@nsx) n'"
      by(rule realizable_Append_matched)
    thus ?case by fastforce
  next
    case (icsSp_Append_call n'' ns' nx p n')
    then obtain ns'' where "realizable n (ns@ns'') nx" by fastforce
    from nx s-pcall n' have "valid_SDG_node n'" by(rule sum_SDG_edge_valid_SDG_node)
    hence "matched n' [] n'" by(rule matched_Nil)
    with ‹realizable n (ns@ns'') nx nx s-pcall n' 
    have "realizable n ((ns@ns'')@[nx]) n'"
      by(fastforce intro:realizable_call sum_SDG_edge_SDG_edge)
    thus ?case by fastforce
  next
    case (icsSp_Append_param_in n'' ns' nx p V n')
    then obtain ns'' where "realizable n (ns@ns'') nx" by fastforce
    from nx s-p:Vin n' have "valid_SDG_node n'"
      by(rule sum_SDG_edge_valid_SDG_node)
    hence "matched n' [] n'" by(rule matched_Nil)
    with ‹realizable n (ns@ns'') nx nx s-p:Vin n' 
    have "realizable n ((ns@ns'')@[nx]) n'"
      by(fastforce intro:realizable_call sum_SDG_edge_SDG_edge)
    thus ?case by fastforce
  qed
qed
      

subsection ‹SDG paths without call edges›

inductive intra_return_sum_SDG_path ::
  "'node SDG_node  'node SDG_node list  'node SDG_node  bool"
("_ irs-_d* _" [51,0,0] 80)
where irsSp_Nil:
  "valid_SDG_node n  n irs-[]d* n"

  | irsSp_Cons_cdep:
  "n'' irs-nsd* n'; n s⟶cd n''  n irs-n#nsd* n'"

  | irsSp_Cons_ddep:
  "n'' irs-nsd* n'; n s-Vdd n''; n  n''  n irs-n#nsd* n'"

  | irsSp_Cons_sum:
  "n'' irs-nsd* n'; n s-psum n''  n irs-n#nsd* n'"

  | irsSp_Cons_return:
  "n'' irs-nsd* n'; n s-pret n''  n irs-n#nsd* n'"

  | irsSp_Cons_param_out:
  "n'' irs-nsd* n'; n s-p:Vout n''  n irs-n#nsd* n'"



lemma irs_SDG_path_Append:
  "n irs-nsd* n''; n'' irs-ns'd* n'  n irs-ns@ns'd* n'"
by(induct rule:intra_return_sum_SDG_path.induct,
   auto intro:intra_return_sum_SDG_path.intros)


lemma is_SDG_path_irs_SDG_path:
  "n is-nsd* n'  n irs-nsd* n'"
proof(induct rule:intra_sum_SDG_path.induct)
  case (isSp_Nil n)
  from ‹valid_SDG_node n show ?case by(rule irsSp_Nil)
next
  case (isSp_Append_cdep n ns n'' n')
  from n'' s⟶cd n' have "n'' irs-[n'']d* n'"
    by(fastforce intro:irsSp_Cons_cdep irsSp_Nil sum_SDG_edge_valid_SDG_node)
  with n irs-nsd* n'' show ?case by(rule irs_SDG_path_Append)
next
  case (isSp_Append_ddep n ns n'' V n')
  from n'' s-Vdd n' n''  n' have "n'' irs-[n'']d* n'"
    by(fastforce intro:irsSp_Cons_ddep irsSp_Nil sum_SDG_edge_valid_SDG_node)
  with n irs-nsd* n'' show ?case by(rule irs_SDG_path_Append)
next
  case (isSp_Append_sum n ns n'' p n')
  from n'' s-psum n' have "n'' irs-[n'']d* n'"
    by(fastforce intro:irsSp_Cons_sum irsSp_Nil sum_SDG_edge_valid_SDG_node)
  with n irs-nsd* n'' show ?case by(rule irs_SDG_path_Append)
qed


lemma irs_SDG_path_split:
  assumes "n irs-nsd* n'"
  obtains "n is-nsd* n'"
  | nsx nsx' nx nx' p where "ns = nsx@nx#nsx'" and "n irs-nsxd* nx"
  and "nx s-pret nx'  (V. nx s-p:Vout nx')" and "nx' is-nsx'd* n'"
proof(atomize_elim)
  from n irs-nsd* n' show "n is-nsd* n' 
    (nsx nx nsx' p nx'. ns = nsx@nx#nsx'  n irs-nsxd* nx  
                        (nx s-pret nx'  (V. nx s-p:Vout nx'))  nx' is-nsx'd* n')"
  proof(induct rule:intra_return_sum_SDG_path.induct)
    case (irsSp_Nil n)
    from ‹valid_SDG_node n have "n is-[]d* n" by(rule isSp_Nil)
    thus ?case by simp
  next
    case (irsSp_Cons_cdep n'' ns n' n)
    from n'' is-nsd* n'  
      (nsx nx nsx' p nx'. ns = nsx@nx#nsx'  n'' irs-nsxd* nx  
                        (nx s-pret nx'  (V. nx s-p:Vout nx'))  nx' is-nsx'd* n')
    show ?case
    proof
      assume "n'' is-nsd* n'"
      from n s⟶cd n'' have "n is-[]@[n]d* n''"
        by(fastforce intro:isSp_Append_cdep isSp_Nil sum_SDG_edge_valid_SDG_node)
      with n'' is-nsd* n' have "n is-[n]@nsd* n'"
        by(fastforce intro:is_SDG_path_Append)
      thus ?case by simp
    next
      assume "nsx nx nsx' p nx'. ns = nsx@nx#nsx'  n'' irs-nsxd* nx  
                        (nx s-pret nx'  (V. nx s-p:Vout nx'))  nx' is-nsx'd* n'"
      then obtain nsx nsx' nx nx' p where "ns = nsx@nx#nsx'" and "n'' irs-nsxd* nx"
        and "nx s-pret nx'  (V. nx s-p:Vout nx')" and "nx' is-nsx'd* n'" by blast
      from n'' irs-nsxd* nx n s⟶cd n'' have "n irs-n#nsxd* nx"
        by(rule intra_return_sum_SDG_path.irsSp_Cons_cdep)
      with ns = nsx@nx#nsx' nx s-pret nx'  (V. nx s-p:Vout nx')
        nx' is-nsx'd* n'
      show ?case by fastforce
    qed
  next
    case (irsSp_Cons_ddep n'' ns n' n V)
    from n'' is-nsd* n'  
      (nsx nx nsx' p nx'. ns = nsx@nx#nsx'  n'' irs-nsxd* nx  
                        (nx s-pret nx'  (V. nx s-p:Vout nx'))  nx' is-nsx'd* n')
    show ?case
    proof
      assume "n'' is-nsd* n'"
      from n s-Vdd n'' n  n'' have "n is-[]@[n]d* n''"
        by(fastforce intro:isSp_Append_ddep isSp_Nil sum_SDG_edge_valid_SDG_node)
      with n'' is-nsd* n' have "n is-[n]@nsd* n'"
        by(fastforce intro:is_SDG_path_Append)
      thus ?case by simp
    next
      assume "nsx nx nsx' p nx'.  ns = nsx@nx#nsx'  n'' irs-nsxd* nx  
                        (nx s-pret nx'  (V. nx s-p:Vout nx'))  nx' is-nsx'd* n'"
      then obtain nsx nsx' nx nx' p where "ns = nsx@nx#nsx'" and "n'' irs-nsxd* nx"
        and "nx s-pret nx'  (V. nx s-p:Vout nx')" and "nx' is-nsx'd* n'" by blast
      from n'' irs-nsxd* nx n s-Vdd n'' n  n'' have "n irs-n#nsxd* nx"
        by(rule intra_return_sum_SDG_path.irsSp_Cons_ddep)
      with ns = nsx@nx#nsx' nx s-pret nx'  (V. nx s-p:Vout nx')
        nx' is-nsx'd* n'
      show ?case by fastforce
    qed
  next
    case (irsSp_Cons_sum n'' ns n' n p)
    from n'' is-nsd* n'  
      (nsx nx nsx' p nx'. ns = nsx@nx#nsx'  n'' irs-nsxd* nx  
                        (nx s-pret nx'  (V. nx s-p:Vout nx'))  nx' is-nsx'd* n')
    show ?case
    proof
      assume "n'' is-nsd* n'"
      from n s-psum n'' have "n is-[]@[n]d* n''"
        by(fastforce intro:isSp_Append_sum isSp_Nil sum_SDG_edge_valid_SDG_node)
      with n'' is-nsd* n' have "n is-[n]@nsd* n'"
        by(fastforce intro:is_SDG_path_Append)
      thus ?case by simp
    next
      assume "nsx nx nsx' p nx'. ns = nsx@nx#nsx'  n'' irs-nsxd* nx  
                        (nx s-pret nx'  (V. nx s-p:Vout nx'))  nx' is-nsx'd* n'"
      then obtain nsx nsx' nx nx' p' where "ns = nsx@nx#nsx'" and "n'' irs-nsxd* nx"
        and "nx s-p'ret nx'  (V. nx s-p':Vout nx')" 
        and "nx' is-nsx'd* n'" by blast
      from n'' irs-nsxd* nx n s-psum n'' have "n irs-n#nsxd* nx"
        by(rule intra_return_sum_SDG_path.irsSp_Cons_sum)
      with ns = nsx@nx#nsx' nx s-p'ret nx'  (V. nx s-p':Vout nx')
        nx' is-nsx'd* n'
      show ?case by fastforce
    qed
  next
    case (irsSp_Cons_return n'' ns n' n p)
    from n'' is-nsd* n'  
      (nsx nx nsx' p nx'. ns = nsx@nx#nsx'  n'' irs-nsxd* nx  
                        (nx s-pret nx'  (V. nx s-p:Vout nx'))  nx' is-nsx'd* n')
    show ?case
    proof
      assume "n'' is-nsd* n'"
      from n s-pret n'' have "valid_SDG_node n" by(rule sum_SDG_edge_valid_SDG_node)
      hence "n irs-[]d* n" by(rule irsSp_Nil)
      with n s-pret n'' n'' is-nsd* n' show ?thesis by fastforce
    next
      assume "nsx nx nsx' p nx'. ns = nsx@nx#nsx'  n'' irs-nsxd* nx  
                        (nx s-pret nx'  (V. nx s-p:Vout nx'))  nx' is-nsx'd* n'"
      then obtain nsx nsx' nx nx' p' where "ns = nsx@nx#nsx'" and "n'' irs-nsxd* nx"
        and "nx s-p'ret nx'  (V. nx s-p':Vout nx')"
        and "nx' is-nsx'd* n'" by blast
      from n'' irs-nsxd* nx n s-pret n'' have "n irs-n#nsxd* nx"
        by(rule intra_return_sum_SDG_path.irsSp_Cons_return)
      with ns = nsx@nx#nsx' nx s-p'ret nx'  (V. nx s-p':Vout nx')
        nx' is-nsx'd* n'
      show ?thesis by fastforce
    qed
  next
    case (irsSp_Cons_param_out n'' ns n' n p V)
    from n'' is-nsd* n'  
      (nsx nx nsx' p nx'. ns = nsx@nx#nsx'  n'' irs-nsxd* nx  
                        (nx s-pret nx'  (V. nx s-p:Vout nx'))  nx' is-nsx'd* n')
    show ?case
    proof
      assume "n'' is-nsd* n'"
      from n s-p:Vout n'' have "valid_SDG_node n"
        by(rule sum_SDG_edge_valid_SDG_node)
      hence "n irs-[]d* n" by(rule irsSp_Nil)
      with n s-p:Vout n'' n'' is-nsd* n' show ?thesis by fastforce
    next
      assume "nsx nx nsx' p nx'. ns = nsx@nx#nsx'  n'' irs-nsxd* nx  
                        (nx s-pret nx'  (V. nx s-p:Vout nx'))  nx' is-nsx'd* n'"
      then obtain nsx nsx' nx nx' p' where "ns = nsx@nx#nsx'" and "n'' irs-nsxd* nx"
        and "nx s-p'ret nx'  (V. nx s-p':Vout nx')" 
        and "nx' is-nsx'd* n'" by blast
      from n'' irs-nsxd* nx n s-p:Vout n'' have "n irs-n#nsxd* nx"
        by(rule intra_return_sum_SDG_path.irsSp_Cons_param_out)
      with ns = nsx@nx#nsx' nx s-p'ret nx'  (V. nx s-p':Vout nx')
        nx' is-nsx'd* n'
      show ?thesis by fastforce
    qed
  qed
qed


lemma irs_SDG_path_matched:
  assumes "n irs-nsd* n''" and "n'' s-pret n'  n'' s-p:Vout n'"
  obtains nx nsx where "matched nx nsx n'" and "n  set nsx" 
  and "nx s-psum CFG_node (parent_node n')"
proof(atomize_elim)
  from assms
  show "nx nsx. matched nx nsx n'  n  set nsx  
                 nx s-psum CFG_node (parent_node n')"
  proof(induct ns arbitrary:n'' n' p V rule:length_induct)
    fix ns n'' n' p V
    assume IH:"ns'. length ns' < length ns 
      (n''. n irs-ns'd* n''  
      (nx' p' V'. (n'' s-p'ret nx'  n'' s-p':V'out nx')  
        (nx nsx. matched nx nsx nx'  n  set nsx  
                  nx s-p'sum CFG_node (parent_node nx'))))"
      and "n irs-nsd* n''" and "n'' s-pret n'  n'' s-p:Vout n'"
    from n'' s-pret n'  n'' s-p:Vout n' have "valid_SDG_node n''"
      by(fastforce intro:sum_SDG_edge_valid_SDG_node)
    from n'' s-pret n'  n'' s-p:Vout n'
    have "n'' -pret n'  n'' -p:Vout n'"
      by(fastforce intro:sum_SDG_edge_SDG_edge SDG_edge_sum_SDG_edge)
    from n'' s-pret n'  n'' s-p:Vout n'
    have "CFG_node (parent_node n'') s-pret CFG_node (parent_node n')"
      by(fastforce elim:sum_SDG_edge.cases intro:sum_SDG_return_edge)
    then obtain a Q f where "valid_edge a" and "kind a = Qpf"
      and "parent_node n'' = sourcenode a" and "parent_node n' = targetnode a"
      by(fastforce elim:sum_SDG_edge.cases)
    from valid_edge a kind a = Qpf obtain a' Q' r' fs' 
      where "a  get_return_edges a'" and "valid_edge a'" and "kind a' = Q':r'pfs'"
      and "CFG_node (sourcenode a') s-psum CFG_node (targetnode a)"
      by(erule return_edge_determines_call_and_sum_edge)
    from valid_edge a' kind a' = Q':r'pfs'
    have "CFG_node (sourcenode a') s-pcall CFG_node (targetnode a')"
      by(fastforce intro:sum_SDG_call_edge)
    from ‹CFG_node (parent_node n'') s-pret CFG_node (parent_node n') 
    have "get_proc (parent_node n'') = p"
      by(auto elim!:sum_SDG_edge.cases intro:get_proc_return)
    from n irs-nsd* n''
    show "nx nsx. matched nx nsx n'  n  set nsx  
                   nx s-psum CFG_node (parent_node n')"
    proof(rule irs_SDG_path_split)
      assume "n is-nsd* n''"
      hence "valid_SDG_node n" by(rule is_SDG_path_valid_SDG_node)
      then obtain asx where "(_Entry_) -asx* parent_node n"
        by(fastforce dest:valid_SDG_CFG_node Entry_path)
      then obtain asx' where "(_Entry_) -asx'* parent_node n"
        and "a'  set asx'. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)"
        by -(erule valid_Entry_path_ascending_path)
      from n is-nsd* n'' obtain as where "parent_node n -asι* parent_node n''"
        by(erule is_SDG_path_CFG_path)
      hence "get_proc (parent_node n) = get_proc (parent_node n'')"
        by(rule intra_path_get_procs)
      from ‹valid_SDG_node n have "valid_node (parent_node n)"
        by(rule valid_SDG_CFG_node)
      hence "valid_SDG_node (CFG_node (parent_node n))" by simp
      have "a as. valid_edge a  (Q p r fs. kind a = Q:rpfs) 
        targetnode a -asι* parent_node n"
      proof(cases "a'  set asx'. intra_kind(kind a')")
        case True
        with (_Entry_) -asx'* parent_node n
        have "(_Entry_) -asx'ι* parent_node n"
          by(fastforce simp:intra_path_def vp_def)
        hence "get_proc (_Entry_) = get_proc (parent_node n)"
          by(rule intra_path_get_procs)
        with get_proc_Entry have "get_proc (parent_node n) = Main" by simp
        from get_proc (parent_node n) = get_proc (parent_node n'')
          get_proc (parent_node n) = Main 
        have "get_proc (parent_node n'') = Main" by simp
        from valid_edge a kind a = Qpf have "get_proc (sourcenode a) = p"
          by(rule get_proc_return)
        with ‹parent_node n'' = sourcenode a get_proc (parent_node n'') = Main
        have "p = Main" by simp
        with kind a = Qpf have "kind a = QMainf" by simp
        with valid_edge a have False by(rule Main_no_return_source)
        thus ?thesis by simp
      next
        assume "¬ (a'set asx'. intra_kind (kind a'))"
        with a'  set asx'. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)
        have "a'  set asx'. Q r p fs. kind a' = Q:rpfs" 
          by(fastforce simp:intra_kind_def)
        then obtain as a' as' where "asx' = as@a'#as'" 
          and "Q r p fs. kind a' = Q:rpfs"
          and "a'  set as'. ¬ (Q r p fs. kind a' = Q:rpfs)"
          by(erule split_list_last_propE)
        with a'  set asx'. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)
        have "a'set as'. intra_kind (kind a')" by(auto simp:intra_kind_def)
        from (_Entry_) -asx'* parent_node n asx' = as@a'#as'
        have "valid_edge a'" and "targetnode a' -as'→* parent_node n"
          by(auto dest:path_split simp:vp_def)
        with a'set as'. intra_kind (kind a') Q r p fs. kind a' = Q:rpfs
        show ?thesis by(fastforce simp:intra_path_def)
      qed
      then obtain ax asx Qx rx fsx px where "valid_edge ax"
        and "kind ax = Qx:rxpxfsx" and "targetnode ax -asxι* parent_node n"
        by blast
      from valid_edge ax kind ax = Qx:rxpxfsx 
      have "get_proc (targetnode ax) = px"
        by(rule get_proc_call)
      from targetnode ax -asxι* parent_node n 
      have "get_proc (targetnode ax) = get_proc (parent_node n)" 
        by(rule intra_path_get_procs)
      with get_proc (parent_node n) = get_proc (parent_node n'') 
        get_proc (targetnode ax) = px
      have "get_proc (parent_node n'') = px" by simp
      with get_proc (parent_node n'') = p have [simp]:"px = p" by simp
      from valid_edge a' valid_edge ax kind a' = Q':r'pfs'
        kind ax = Qx:rxpxfsx
      have "targetnode a' = targetnode ax" by simp(rule same_proc_call_unique_target)
      have "parent_node n  (_Exit_)"
      proof
        assume "parent_node n = (_Exit_)"
        from n is-nsd* n'' obtain as where "parent_node n -asι* parent_node n''"
          by(erule is_SDG_path_CFG_path)
        with ‹parent_node n = (_Exit_)
        have "(_Exit_) -as→* parent_node n''" by(simp add:intra_path_def)
        hence "parent_node n'' = (_Exit_)" by(fastforce dest:path_Exit_source)
        from get_proc (parent_node n'') = p ‹parent_node n'' = (_Exit_)
          ‹parent_node n'' = sourcenode a get_proc_Exit 
        have "p = Main" by simp
        with kind a = Qpf have "kind a = QMainf" by simp
        with valid_edge a show False by(rule Main_no_return_source)
      qed
      have "nsx. CFG_node (targetnode a') cd-nsxd* CFG_node (parent_node n)"
      proof(cases "targetnode a' = parent_node n")
        case True
        with ‹valid_SDG_node (CFG_node (parent_node n)) 
        have "CFG_node (targetnode a') cd-[]d* CFG_node (parent_node n)"
          by(fastforce intro:cdSp_Nil)
        thus ?thesis by blast
      next
        case False
        with targetnode ax -asxι* parent_node n ‹parent_node n  (_Exit_)
          valid_edge ax kind ax = Qx:rxpxfsx targetnode a' = targetnode ax
        obtain nsx 
          where "CFG_node (targetnode a') cd-nsxd* CFG_node (parent_node n)"
          by(fastforce elim!:in_proc_cdep_SDG_path)
        thus ?thesis by blast
      qed
      then obtain nsx 
        where "CFG_node (targetnode a') cd-nsxd* CFG_node (parent_node n)" by blast
      hence "CFG_node (targetnode a') i-nsxd* CFG_node (parent_node n)"
        by(rule cdep_SDG_path_intra_SDG_path)
      show ?thesis
      proof(cases ns)
        case Nil
        with n is-nsd* n'' have "n = n''"
          by(fastforce elim:intra_sum_SDG_path.cases)
        from valid_edge a' kind a' = Q':r'pfs' a  get_return_edges a'
        have "matched (CFG_node (targetnode a')) [CFG_node (targetnode a')]
          (CFG_node (sourcenode a))" by(rule intra_proc_matched)
        from ‹valid_SDG_node n''
        have "n'' = CFG_node (parent_node n'')  CFG_node (parent_node n'')cd n''"
          by(rule valid_SDG_node_cases)
        hence "nsx. CFG_node (parent_node n'') i-nsxd* n''"
        proof
          assume "n'' = CFG_node (parent_node n'')"
          with ‹valid_SDG_node n'' have "CFG_node (parent_node n'') i-[]d* n''"
            by(fastforce intro:iSp_Nil)
          thus ?thesis by blast
        next
          assume "CFG_node (parent_node n'')cd n''"
          from ‹valid_SDG_node n'' have "valid_node (parent_node n'')"
            by(rule valid_SDG_CFG_node)
          hence "valid_SDG_node (CFG_node (parent_node n''))" by simp
          hence "CFG_node (parent_node n'') i-[]d* CFG_node (parent_node n'')"
            by(rule iSp_Nil)
          with ‹CFG_node (parent_node n'')cd n''
          have "CFG_node (parent_node n'') i-[]@[CFG_node (parent_node n'')]d* n''"
            by(fastforce intro:iSp_Append_cdep sum_SDG_edge_SDG_edge)
          thus ?thesis by blast
        qed
        with ‹parent_node n'' = sourcenode a
        obtain nsx where "CFG_node (sourcenode a) i-nsxd* n''" by fastforce
        with ‹matched (CFG_node (targetnode a')) [CFG_node (targetnode a')]
          (CFG_node (sourcenode a))
        have "matched (CFG_node (targetnode a')) ([CFG_node (targetnode a')]@nsx) n''"
          by(fastforce intro:matched_Append intra_SDG_path_matched)
        moreover
        from valid_edge a' kind a' = Q':r'pfs'
        have "CFG_node (sourcenode a') -pcall CFG_node (targetnode a')"
          by(fastforce intro:SDG_call_edge)
        moreover
        from valid_edge a' have "valid_SDG_node (CFG_node (sourcenode a'))"
          by simp
        hence "matched (CFG_node (sourcenode a')) [] (CFG_node (sourcenode a'))"
          by(rule matched_Nil)
        ultimately have "matched (CFG_node (sourcenode a'))
          ([]@(CFG_node (sourcenode a'))#([CFG_node (targetnode a')]@nsx)@[n'']) n'"
          using n'' s-pret n'  n'' s-p:Vout n' ‹parent_node n' = targetnode a
            ‹parent_node n'' = sourcenode a valid_edge a' a  get_return_edges a'
          by(fastforce intro:matched_bracket_call dest:sum_SDG_edge_SDG_edge)
        with n = n'' ‹CFG_node (sourcenode a') s-psum CFG_node (targetnode a)
          ‹parent_node n' = targetnode a
        show ?thesis by fastforce
      next
        case Cons
        with n is-nsd* n'' have "n  set ns"
          by(induct rule:intra_sum_SDG_path_rev_induct) auto
        from n is-nsd* n'' obtain ns' where "matched n ns' n''" 
          and "set ns  set ns'" by(erule is_SDG_path_matched)
        with n  set ns have "n  set ns'" by fastforce
        from ‹valid_SDG_node n
        have "n = CFG_node (parent_node n)  CFG_node (parent_node n)cd n"
          by(rule valid_SDG_node_cases)
        hence "nsx. CFG_node (parent_node n) i-nsxd* n"
        proof
          assume "n = CFG_node (parent_node n)"
          with ‹valid_SDG_node n have "CFG_node (parent_node n) i-[]d* n"
            by(fastforce intro:iSp_Nil)
          thus ?thesis by blast
        next
          assume "CFG_node (parent_node n)cd n"
          from ‹valid_SDG_node (CFG_node (parent_node n)) 
          have "CFG_node (parent_node n) i-[]d* CFG_node (parent_node n)"
            by(rule iSp_Nil)
          with ‹CFG_node (parent_node n)cd n
          have "CFG_node (parent_node n) i-[]@[CFG_node (parent_node n)]d* n"
            by(fastforce intro:iSp_Append_cdep sum_SDG_edge_SDG_edge)
          thus ?thesis by blast
        qed
        then obtain nsx' where "CFG_node (parent_node n) i-nsx'd* n" by blast
        with ‹CFG_node (targetnode a') i-nsxd* CFG_node (parent_node n)
        have "CFG_node (targetnode a') i-nsx@nsx'd* n"
          by -(rule intra_SDG_path_Append)
        hence "matched (CFG_node (targetnode a')) (nsx@nsx') n"
          by(rule intra_SDG_path_matched)
        with ‹matched n ns' n'' 
        have "matched (CFG_node (targetnode a')) ((nsx@nsx')@ns') n''"
          by(rule matched_Append)
        moreover
        from valid_edge a' kind a' = Q':r'pfs'
        have "CFG_node (sourcenode a') -pcall CFG_node (targetnode a')"
          by(fastforce intro:SDG_call_edge)
        moreover
        from valid_edge a' have "valid_SDG_node (CFG_node (sourcenode a'))"
          by simp
        hence "matched (CFG_node (sourcenode a')) [] (CFG_node (sourcenode a'))"
          by(rule matched_Nil)
        ultimately have "matched (CFG_node (sourcenode a')) 
          ([]@(CFG_node (sourcenode a'))#((nsx@nsx')@ns')@[n'']) n'"
          using  n'' s-pret n'  n'' s-p:Vout n' ‹parent_node n' = targetnode a
            ‹parent_node n'' = sourcenode a valid_edge a' a  get_return_edges a'
          by(fastforce intro:matched_bracket_call dest:sum_SDG_edge_SDG_edge)
        with ‹CFG_node (sourcenode a') s-psum CFG_node (targetnode a)
          ‹parent_node n' = targetnode a n  set ns'
        show ?thesis by fastforce
      qed
    next
      fix ms ms' m m' px
      assume "ns = ms@m#ms'" and "n irs-msd* m"
        and "m s-pxret m'  (V. m s-px:Vout m')" and "m' is-ms'd* n''"
      from ns = ms@m#ms' have "length ms < length ns" by simp
      with IH n irs-msd* m m s-pxret m'  (V. m s-px:Vout m') obtain mx msx
        where "matched mx msx m'" and "n  set msx" 
        and "mx s-pxsum CFG_node (parent_node m')" by fastforce
      from m' is-ms'd* n'' obtain msx' where "matched m' msx' n''"
        by -(erule is_SDG_path_matched)
      with ‹matched mx msx m' have "matched mx (msx@msx') n''"
        by -(rule matched_Append)
      from m s-pxret m'  (V. m s-px:Vout m')
      have "m -pxret m'  (V. m -px:Vout m')"
        by(auto intro:sum_SDG_edge_SDG_edge SDG_edge_sum_SDG_edge)
      from m s-pxret m'  (V. m s-px:Vout m')
      have "CFG_node (parent_node m) s-pxret CFG_node (parent_node m')"
        by(fastforce elim:sum_SDG_edge.cases intro:sum_SDG_return_edge)
      then obtain ax Qx fx where "valid_edge ax" and "kind ax = Qxpxfx"
      and "parent_node m = sourcenode ax" and "parent_node m' = targetnode ax"
        by(fastforce elim:sum_SDG_edge.cases)
      from valid_edge ax kind ax = Qxpxfx obtain ax' Qx' rx' fsx' 
        where "ax  get_return_edges ax'" and "valid_edge ax'" 
        and "kind ax' = Qx':rx'pxfsx'"
        and "CFG_node (sourcenode ax') s-pxsum CFG_node (targetnode ax)"
        by(erule return_edge_determines_call_and_sum_edge)
      from valid_edge ax' kind ax' = Qx':rx'pxfsx'
      have "CFG_node (sourcenode ax') s-pxcall CFG_node (targetnode ax')"
        by(fastforce intro:sum_SDG_call_edge)
      from mx s-pxsum CFG_node (parent_node m')
      have "valid_SDG_node mx" by(rule sum_SDG_edge_valid_SDG_node)
      have "msx''. CFG_node (targetnode a') cd-msx''d* mx"
      proof(cases "targetnode a' = parent_node mx")
        case True
        from ‹valid_SDG_node mx 
        have "mx = CFG_node (parent_node mx)  CFG_node (parent_node mx)cd mx"
          by(rule valid_SDG_node_cases)
        thus ?thesis
        proof
          assume "mx = CFG_node (parent_node mx)"
          with ‹valid_SDG_node mx True
          have "CFG_node (targetnode a') cd-[]d* mx" by(fastforce intro:cdSp_Nil)
          thus ?thesis by blast
        next
          assume "CFG_node (parent_node mx)cd mx"
          with valid_edge a' True[THEN sym]
          have "CFG_node (targetnode a') cd-[]@[CFG_node (targetnode a')]d* mx"
            by(fastforce intro:cdep_SDG_path.intros)
          thus ?thesis by blast
        qed
      next
        case False
        show ?thesis
        proof(cases "ai. valid_edge ai  sourcenode ai = parent_node mx
             ai  get_return_edges a'")
          case True
          { assume "parent_node mx = (_Exit_)"
            with mx s-pxsum CFG_node (parent_node m')
            obtain ai where "valid_edge ai" and "sourcenode ai = (_Exit_)"
              by -(erule sum_SDG_edge.cases,auto)
            hence False by(rule Exit_source) }
          hence "parent_node mx  (_Exit_)" by fastforce
          from ‹valid_SDG_node mx have "valid_node (parent_node mx)"
            by(rule valid_SDG_CFG_node)
          then obtain asx where "(_Entry_) -asx* parent_node mx"
            by(fastforce intro:Entry_path)
          then obtain asx' where "(_Entry_) -asx'* parent_node mx"
            and "a'  set asx'. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)"
            by -(erule valid_Entry_path_ascending_path)
          from mx s-pxsum CFG_node (parent_node m')
          obtain nsi where "matched mx nsi (CFG_node (parent_node m'))"
            by -(erule sum_SDG_summary_edge_matched)
          then obtain asi where "parent_node mx -asisl* parent_node m'"
            by(fastforce elim:matched_same_level_CFG_path)
          hence "get_proc (parent_node mx) = get_proc (parent_node m')"
            by(rule slp_get_proc)
          from m' is-ms'd* n'' obtain nsi' where "matched m' nsi' n''"
            by -(erule is_SDG_path_matched)
          then obtain asi' where "parent_node m' -asi'sl* parent_node n''"
            by -(erule matched_same_level_CFG_path)
          hence "get_proc (parent_node m') = get_proc (parent_node n'')"
            by(rule slp_get_proc)
          with get_proc (parent_node mx) = get_proc (parent_node m')
          have "get_proc (parent_node mx) = get_proc (parent_node n'')" by simp
          from get_proc (parent_node n'') = p 
            get_proc (parent_node mx) = get_proc (parent_node n'')
          have "get_proc (parent_node mx) = p" by simp
          have "asx. targetnode a' -asxι* parent_node mx"
          proof(cases "a'  set asx'. intra_kind(kind a')")
            case True
            with (_Entry_) -asx'* parent_node mx 
            have "(_Entry_) -asx'ι* parent_node mx"
              by(simp add:vp_def intra_path_def)
            hence "get_proc (_Entry_) = get_proc (parent_node mx)"
              by(rule intra_path_get_procs)
            with get_proc (parent_node mx) = p have "get_proc (_Entry_) = p"
              by simp
            with ‹CFG_node (parent_node n'') s-pret CFG_node (parent_node n')
            have False
              by -(erule sum_SDG_edge.cases,
                auto intro:Main_no_return_source simp:get_proc_Entry)
            thus ?thesis by simp
          next
            case False
            hence "a'  set asx'. ¬ intra_kind (kind a')" by fastforce
            then obtain ai as' as'' where "asx' = as'@ai#as''" 
              and "¬ intra_kind (kind ai)" and "a'  set as''. intra_kind (kind a')"
              by(fastforce elim!:split_list_last_propE)
            from asx' = as'@ai#as'' ¬ intra_kind (kind ai)
              a'  set asx'. intra_kind(kind a')  (Q r p fs. kind a' = Q:rpfs)
            obtain Qi ri pi fsi where "kind ai = Qi:ripifsi" 
              and "a'  set as'. intra_kind(kind a')  
              (Q r p fs. kind a' = Q:rpfs)"
              by auto
            from (_Entry_) -asx'* parent_node mx asx' = as'@ai#as''
              a'  set as''. intra_kind (kind a')
            have "valid_edge ai" and "targetnode ai -as''ι* parent_node mx"
              by(auto intro:path_split simp:vp_def intra_path_def)
            hence "get_proc (targetnode ai) = get_proc (parent_node mx)"
              by -(rule intra_path_get_procs)
            with get_proc (parent_node mx) = p valid_edge ai
              kind ai = Qi:ripifsi
            have [simp]:"pi = p" by(fastforce dest:get_proc_call)
            from valid_edge ai valid_edge a' 
              kind ai = Qi:ripifsi kind a' = Q':r'pfs'
            have "targetnode ai = targetnode a'" 
              by(fastforce intro:same_proc_call_unique_target)
            with targetnode ai -as''ι* parent_node mx
            show ?thesis by fastforce
          qed
          then obtain asx where "targetnode a' -asxι* parent_node mx" by blast
          from this valid_edge a' kind a' = Q':r'pfs'
            ‹parent_node mx  (_Exit_) targetnode a'  parent_node mx True
          obtain msi 
            where "CFG_node(targetnode a') cd-msid* CFG_node(parent_node mx)"
            by(fastforce elim!:in_proc_cdep_SDG_path)
          from ‹valid_SDG_node mx 
          have "mx = CFG_node (parent_node mx)  CFG_node (parent_node mx)cd mx"
            by(rule valid_SDG_node_cases)
          thus ?thesis
          proof
            assume "mx = CFG_node (parent_node mx)"
            with ‹CFG_node(targetnode a')cd-msid* CFG_node(parent_node mx)
            show ?thesis by fastforce
          next
            assume "CFG_node (parent_node mx)cd mx"
            with ‹CFG_node(targetnode a')cd-msid* CFG_node(parent_node mx)
            have "CFG_node(targetnode a') cd-msi@[CFG_node(parent_node mx)]d* mx"
              by(fastforce intro:cdSp_Append_cdep)
            thus ?thesis by fastforce
          qed
        next
          case False
          then obtain ai where "valid_edge ai" and "sourcenode ai = parent_node mx"
            and "ai  get_return_edges a'" by blast
          with valid_edge a' kind a' = Q':r'pfs'
          have "CFG_node (targetnode a')cd CFG_node (parent_node mx)"
            by(auto intro:SDG_proc_entry_exit_cdep)       
          with valid_edge a' 
          have cd_path:"CFG_node (targetnode a') cd-[]@[CFG_node (targetnode a')]d* 
                        CFG_node (parent_node mx)"
            by(fastforce intro:cdSp_Append_cdep cdSp_Nil)
          from ‹valid_SDG_node mx 
          have "mx = CFG_node (parent_node mx)  CFG_node (parent_node mx)cd mx"
            by(rule valid_SDG_node_cases)
          thus ?thesis
          proof
            assume "mx = CFG_node (parent_node mx)"
            with cd_path show ?thesis by fastforce
          next
            assume "CFG_node (parent_node mx)cd mx"
            with cd_path have "CFG_node (targetnode a') 
              cd-[CFG_node (targetnode a')]@[CFG_node (parent_node mx)]d* mx"
              by(fastforce intro:cdSp_Append_cdep)
            thus ?thesis by fastforce
          qed
        qed
      qed
      then obtain msx'' 
        where "CFG_node (targetnode a') cd-msx''d* mx" by blast
      hence "CFG_node (targetnode a') i-msx''d* mx"
        by(rule cdep_SDG_path_intra_SDG_path)
      with valid_edge a' 
      have "matched (CFG_node (targetnode a')) ([]@msx'') mx"
        by(fastforce intro:matched_Append_intra_SDG_path matched_Nil)
      with ‹matched mx (msx@msx') n''
      have "matched (CFG_node (targetnode a')) (msx''@(msx@msx')) n''"
        by(fastforce intro:matched_Append)
      with valid_edge a' ‹CFG_node (sourcenode a') s-pcall CFG_node (targetnode a')
        n'' -pret n'  n'' -p:Vout n' a  get_return_edges a'
        ‹parent_node n'' = sourcenode a ‹parent_node n' = targetnode a
      have "matched (CFG_node (sourcenode a')) 
        ([]@CFG_node (sourcenode a')#(msx''@(msx@msx'))@[n'']) n'"
        by(fastforce intro:matched_bracket_call matched_Nil sum_SDG_edge_SDG_edge)
      with n  set msx ‹CFG_node (sourcenode a') s-psum CFG_node (targetnode a)
        ‹parent_node n' = targetnode a
      show ?thesis by fastforce
    qed
  qed
qed


lemma irs_SDG_path_realizable:
  assumes "n irs-nsd* n'" and "n  n'"
  obtains ns' where "realizable (CFG_node (_Entry_)) ns' n'" and "n  set ns'"
proof(atomize_elim)
  from n irs-nsd* n'
  have "n = n'  (ns'. realizable (CFG_node (_Entry_)) ns' n'  n  set ns')"
  proof(rule irs_SDG_path_split)
    assume "n is-nsd* n'"
    show ?thesis
    proof(cases "ns = []")
      case True
      with n is-nsd* n' have "n = n'" by(fastforce elim:intra_sum_SDG_path.cases)
      thus ?thesis by simp
    next
      case False
      with n is-nsd* n' have "n  set ns" by(fastforce dest:is_SDG_path_hd)
      from n is-nsd* n' have "valid_SDG_node n" and "valid_SDG_node n'"
        by(rule is_SDG_path_valid_SDG_node)+
      hence "valid_node (parent_node n)" by -(rule valid_SDG_CFG_node)
      from n is-nsd* n' obtain ns' where "matched n ns' n'" and "set ns  set ns'"
        by(erule is_SDG_path_matched)
      with n  set ns have "n  set ns'" by fastforce
      from ‹valid_node (parent_node n)
      show ?thesis
      proof(cases "parent_node n = (_Exit_)")
        case True
        with ‹valid_SDG_node n have "n = CFG_node (_Exit_)"
          by(rule valid_SDG_node_parent_Exit)
        from n is-nsd* n' obtain as where "parent_node n -asι* parent_node n'"
          by -(erule is_SDG_path_intra_CFG_path)
        with n = CFG_node (_Exit_) have "parent_node n' = (_Exit_)"
          by(fastforce dest:path_Exit_source simp:intra_path_def)
        with ‹valid_SDG_node n' have "n' = CFG_node (_Exit_)"
          by(rule valid_SDG_node_parent_Exit)
        with n = CFG_node (_Exit_) show ?thesis by simp
      next
        case False
        with ‹valid_SDG_node n
        obtain nsx where "CFG_node (_Entry_) cc-nsxd* n"
          by(erule Entry_cc_SDG_path_to_inner_node)
        hence "realizable (CFG_node (_Entry_)) nsx n" 
          by(rule cdep_SDG_path_realizable)
        with ‹matched n ns' n'
        have "realizable (CFG_node (_Entry_)) (nsx@ns') n'"
          by -(rule realizable_Append_matched)
        with n  set ns' show ?thesis by fastforce
      qed
    qed
  next
    fix nsx nsx' nx nx' p
    assume "ns = nsx@nx#nsx'" and "n irs-nsxd* nx"
      and "nx s-pret nx'  (V. nx s-p:Vout nx')" and "nx' is-nsx'd* n'"
    from nx s-pret nx'  (V. nx s-p:Vout nx')
    have "CFG_node (parent_node nx) s-pret CFG_node (parent_node nx')"
      by(fastforce elim:sum_SDG_edge.cases intro:sum_SDG_return_edge)
    then obtain a Q f where "valid_edge a" and "kind a = Qpf"
      and "parent_node nx = sourcenode a" and "parent_node nx' = targetnode a"
      by(fastforce elim:sum_SDG_edge.cases)
    from valid_edge a kind a = Qpf obtain a' Q' r' fs' 
      where "a  get_return_edges a'" and "valid_edge a'" and "kind a' = Q':r'pfs'"
      and "CFG_node (sourcenode a') s-psum CFG_node (targetnode a)"
      by(erule return_edge_determines_call_and_sum_edge)
    from valid_edge a' kind a' = Q':r'pfs'
    have "CFG_node (sourcenode a') s-pcall CFG_node (targetnode a')"
      by(fastforce intro:sum_SDG_call_edge)
    from n irs-nsxd* nx nx s-pret nx'  (V. nx s-p:Vout nx')
    obtain m ms where "matched m ms nx'" and "n  set ms"
      and "m s-psum CFG_node (parent_node nx')"
      by(fastforce elim:irs_SDG_path_matched)
    from nx' is-nsx'd* n' obtain ms' where "matched nx' ms' n'" 
      and "set nsx'  set ms'" by(erule is_SDG_path_matched)
    with ‹matched m ms nx' have "matched m (ms@ms') n'" by -(rule matched_Append)
   from m s-psum CFG_node (parent_node nx') have "valid_SDG_node m"
      by(rule sum_SDG_edge_valid_SDG_node)
    hence "valid_node (parent_node m)" by(rule valid_SDG_CFG_node)
    thus ?thesis
    proof(cases "parent_node m = (_Exit_)")
      case True
      from m s-psum CFG_node (parent_node nx') obtain a where "valid_edge a" 
        and "sourcenode a = parent_node m"
        by(fastforce elim:sum_SDG_edge.cases)
      with True have False by -(rule Exit_source,simp_all)
      thus ?thesis by simp
    next
      case False
      with ‹valid_SDG_node m
      obtain ms'' where "CFG_node (_Entry_) cc-ms''d* m"
        by(erule Entry_cc_SDG_path_to_inner_node)
      hence "realizable (CFG_node (_Entry_)) ms'' m" 
        by(rule cdep_SDG_path_realizable)
      with ‹matched m (ms@ms') n'
      have "realizable (CFG_node (_Entry_)) (ms''@(ms@ms')) n'"
        by -(rule realizable_Append_matched)
      with n  set ms show ?thesis by fastforce
    qed
  qed
  with n  n' show "ns'. realizable (CFG_node (_Entry_)) ns' n'  n  set ns'"
    by simp
qed

end

end

Theory HRBSlice

section ‹Horwitz-Reps-Binkley Slice›

theory HRBSlice imports SDG begin

context SDG begin

subsection ‹Set describing phase 1 of the two-phase slicer›

inductive_set sum_SDG_slice1 :: "'node SDG_node  'node SDG_node set"
  for n::"'node SDG_node"
  where refl_slice1:"valid_SDG_node n  n  sum_SDG_slice1 n"
  | cdep_slice1:
  "n'' s⟶cd n'; n'  sum_SDG_slice1 n  n''  sum_SDG_slice1 n"
  | ddep_slice1: 
  "n'' s-Vdd n'; n'  sum_SDG_slice1 n  n''  sum_SDG_slice1 n"
  | call_slice1:
  "n'' s-pcall n'; n'  sum_SDG_slice1 n  n''  sum_SDG_slice1 n"
  | param_in_slice1: 
  "n'' s-p:Vin n'; n'  sum_SDG_slice1 n  n''  sum_SDG_slice1 n"
  | sum_slice1:
  "n'' s-psum n'; n'  sum_SDG_slice1 n  n''  sum_SDG_slice1 n"


lemma slice1_cdep_slice1:
  "nx  sum_SDG_slice1 n; n s⟶cd n'  nx  sum_SDG_slice1 n'"
by(induct rule:sum_SDG_slice1.induct,
   auto intro:sum_SDG_slice1.intros sum_SDG_edge_valid_SDG_node)

lemma slice1_ddep_slice1:
  "nx  sum_SDG_slice1 n; n s-Vdd n'  nx  sum_SDG_slice1 n'"
by(induct rule:sum_SDG_slice1.induct,
   auto intro:sum_SDG_slice1.intros sum_SDG_edge_valid_SDG_node)

lemma slice1_sum_slice1:
  "nx  sum_SDG_slice1 n; n s-psum n'  nx  sum_SDG_slice1 n'"
by(induct rule:sum_SDG_slice1.induct,
   auto intro:sum_SDG_slice1.intros sum_SDG_edge_valid_SDG_node)

lemma slice1_call_slice1:
  "nx  sum_SDG_slice1 n; n s-pcall n'  nx  sum_SDG_slice1 n'"
by(induct rule:sum_SDG_slice1.induct,
   auto intro:sum_SDG_slice1.intros sum_SDG_edge_valid_SDG_node)

lemma slice1_param_in_slice1:
  "nx  sum_SDG_slice1 n; n s-p:Vin n'  nx  sum_SDG_slice1 n'"
by(induct rule:sum_SDG_slice1.induct,
   auto intro:sum_SDG_slice1.intros sum_SDG_edge_valid_SDG_node)


lemma is_SDG_path_slice1:
  "n is-nsd* n'; n'  sum_SDG_slice1 n''  n  sum_SDG_slice1 n''"
proof(induct rule:intra_sum_SDG_path.induct)
  case isSp_Nil thus ?case by simp
next
  case (isSp_Append_cdep n ns nx n')
  note IH = nx  sum_SDG_slice1 n''  n  sum_SDG_slice1 n''
  from nx s⟶cd n' n'  sum_SDG_slice1 n''
  have "nx  sum_SDG_slice1 n''" by(rule cdep_slice1)
  from IH[OF this] show ?case .
next
  case (isSp_Append_ddep n ns nx V n')
  note IH = nx  sum_SDG_slice1 n''  n  sum_SDG_slice1 n''
  from nx s-Vdd n' n'  sum_SDG_slice1 n''
  have "nx  sum_SDG_slice1 n''" by(rule ddep_slice1)
  from IH[OF this] show ?case .
next
  case (isSp_Append_sum n ns nx p n')
  note IH = nx  sum_SDG_slice1 n''  n  sum_SDG_slice1 n''
  from nx s-psum n' n'  sum_SDG_slice1 n''
  have "nx  sum_SDG_slice1 n''" by(rule sum_slice1)
  from IH[OF this] show ?case .
qed


subsection ‹Set describing phase 2 of the two-phase slicer›

inductive_set sum_SDG_slice2 :: "'node SDG_node  'node SDG_node set"
  for n::"'node SDG_node"
  where refl_slice2:"valid_SDG_node n  n  sum_SDG_slice2 n"
  | cdep_slice2:
  "n'' s⟶cd n'; n'  sum_SDG_slice2 n  n''  sum_SDG_slice2 n"
  | ddep_slice2: 
  "n'' s-Vdd n'; n'  sum_SDG_slice2 n  n''  sum_SDG_slice2 n"
  | return_slice2:
  "n'' s-pret n'; n'  sum_SDG_slice2 n  n''  sum_SDG_slice2 n"
  | param_out_slice2: 
  "n'' s-p:Vout n'; n'  sum_SDG_slice2 n  n''  sum_SDG_slice2 n"
  | sum_slice2:
  "n'' s-psum n'; n'  sum_SDG_slice2 n  n''  sum_SDG_slice2 n"


lemma slice2_cdep_slice2:
  "nx  sum_SDG_slice2 n; n s⟶cd n'  nx  sum_SDG_slice2 n'"
by(induct rule:sum_SDG_slice2.induct,
   auto intro:sum_SDG_slice2.intros sum_SDG_edge_valid_SDG_node)

lemma slice2_ddep_slice2:
  "nx  sum_SDG_slice2 n; n s-Vdd n'  nx  sum_SDG_slice2 n'"
by(induct rule:sum_SDG_slice2.induct,
   auto intro:sum_SDG_slice2.intros sum_SDG_edge_valid_SDG_node)

lemma slice2_sum_slice2:
  "nx  sum_SDG_slice2 n; n s-psum n'  nx  sum_SDG_slice2 n'"
by(induct rule:sum_SDG_slice2.induct,
   auto intro:sum_SDG_slice2.intros sum_SDG_edge_valid_SDG_node)

lemma slice2_ret_slice2:
  "nx  sum_SDG_slice2 n; n s-pret n'  nx  sum_SDG_slice2 n'"
by(induct rule:sum_SDG_slice2.induct,
   auto intro:sum_SDG_slice2.intros sum_SDG_edge_valid_SDG_node)

lemma slice2_param_out_slice2:
  "nx  sum_SDG_slice2 n; n s-p:Vout n'  nx  sum_SDG_slice2 n'"
by(induct rule:sum_SDG_slice2.induct,
   auto intro:sum_SDG_slice2.intros sum_SDG_edge_valid_SDG_node)


lemma is_SDG_path_slice2:
  "n is-nsd* n'; n'  sum_SDG_slice2 n''  n  sum_SDG_slice2 n''"
proof(induct rule:intra_sum_SDG_path.induct)
  case isSp_Nil thus ?case by simp
next
  case (isSp_Append_cdep n ns nx n')
  note IH = nx  sum_SDG_slice2 n''  n  sum_SDG_slice2 n''
  from nx s⟶cd n' n'  sum_SDG_slice2 n''
  have "nx  sum_SDG_slice2 n''" by(rule cdep_slice2)
  from IH[OF this] show ?case .
next
  case (isSp_Append_ddep n ns nx V n')
  note IH = nx  sum_SDG_slice2 n''  n  sum_SDG_slice2 n''
  from nx s-Vdd n' n'  sum_SDG_slice2 n''
  have "nx  sum_SDG_slice2 n''" by(rule ddep_slice2)
  from IH[OF this] show ?case .
next
  case (isSp_Append_sum n ns nx p n')
  note IH = nx  sum_SDG_slice2 n''  n  sum_SDG_slice2 n''
  from nx s-psum n' n'  sum_SDG_slice2 n''
  have "nx  sum_SDG_slice2 n''" by(rule sum_slice2)
  from IH[OF this] show ?case .
qed



lemma slice2_is_SDG_path_slice2: 
  "n is-nsd* n'; n''  sum_SDG_slice2 n  n''  sum_SDG_slice2 n'"
proof(induct rule:intra_sum_SDG_path.induct)
  case isSp_Nil thus ?case by simp
next
  case (isSp_Append_cdep n ns nx n')
  from n''  sum_SDG_slice2 n  n''  sum_SDG_slice2 nx n''  sum_SDG_slice2 n
  have "n''  sum_SDG_slice2 nx" .
  with nx s⟶cd n' show ?case by -(rule slice2_cdep_slice2)
next
  case (isSp_Append_ddep n ns nx V n')
  from n''  sum_SDG_slice2 n  n''  sum_SDG_slice2 nx n''  sum_SDG_slice2 n
  have "n''  sum_SDG_slice2 nx" .
  with nx s-Vdd n' show ?case by -(rule slice2_ddep_slice2)
next
  case (isSp_Append_sum n ns nx p n')
  from n''  sum_SDG_slice2 n  n''  sum_SDG_slice2 nx n''  sum_SDG_slice2 n
  have "n''  sum_SDG_slice2 nx" .
  with nx s-psum n' show ?case by -(rule slice2_sum_slice2)
qed


subsection ‹The backward slice using the Horwitz-Reps-Binkley slicer›

text ‹Note: our slicing criterion is a set of nodes, not a unique node.›

inductive_set combine_SDG_slices :: "'node SDG_node set  'node SDG_node set"
  for S::"'node SDG_node set"
  where combSlice_refl:"n  S  n  combine_SDG_slices S" 
  | combSlice_Return_parent_node:
  "n'  S; n'' s-pret CFG_node (parent_node n'); n  sum_SDG_slice2 n' 
   n  combine_SDG_slices S"


definition HRB_slice :: "'node SDG_node set  'node SDG_node set"
  where "HRB_slice S  {n'. n  S. n'  combine_SDG_slices (sum_SDG_slice1 n)}"


lemma HRB_slice_cases[consumes 1,case_names phase1 phase2]:
  "x  HRB_slice S; n nx. n  sum_SDG_slice1 nx; nx  S  P n;
   nx n' n'' p n. n'  sum_SDG_slice1 nx; n'' s-pret CFG_node (parent_node n'); 
                    n  sum_SDG_slice2 n'; nx  S  P n
   P x"
  by(fastforce elim:combine_SDG_slices.cases simp:HRB_slice_def)



lemma HRB_slice_refl:
  assumes "valid_node m" and "CFG_node m  S" shows "CFG_node m  HRB_slice S"
proof -
  from ‹valid_node m have "CFG_node m  sum_SDG_slice1 (CFG_node m)"
    by(fastforce intro:refl_slice1)
  with ‹CFG_node m  S show ?thesis
    by(simp add:HRB_slice_def)(blast intro:combSlice_refl)
qed


lemma HRB_slice_valid_node: "n  HRB_slice S  valid_SDG_node n"
proof(induct rule:HRB_slice_cases)
  case (phase1 n nx) thus ?case
    by(induct rule:sum_SDG_slice1.induct,auto intro:sum_SDG_edge_valid_SDG_node)
next
  case (phase2 nx n' n'' p n)
  from n  sum_SDG_slice2 n'
  show ?case
    by(induct rule:sum_SDG_slice2.induct,auto intro:sum_SDG_edge_valid_SDG_node)
qed


lemma valid_SDG_node_in_slice_parent_node_in_slice:
  assumes "n  HRB_slice S" shows "CFG_node (parent_node n)  HRB_slice S"
proof -
  from n  HRB_slice S have "valid_SDG_node n" by(rule HRB_slice_valid_node)
  hence "n = CFG_node (parent_node n)  CFG_node (parent_node n)cd n"
    by(rule valid_SDG_node_cases)
  thus ?thesis
  proof
    assume "n = CFG_node (parent_node n)"
    with n  HRB_slice S show ?thesis by simp
  next
    assume "CFG_node (parent_node n)cd n"
    hence "CFG_node (parent_node n) s⟶cd n" by(rule SDG_edge_sum_SDG_edge)
    with n  HRB_slice S show ?thesis
      by(fastforce elim:combine_SDG_slices.cases 
                 intro:combine_SDG_slices.intros cdep_slice1 cdep_slice2 
                  simp:HRB_slice_def)
  qed
qed


lemma HRB_slice_is_SDG_path_HRB_slice: 
  "n is-nsd* n'; n''  HRB_slice {n}; n'  S  n''  HRB_slice S"
proof(induct arbitrary:S rule:intra_sum_SDG_path.induct)
  case (isSp_Nil n) thus ?case by(fastforce simp:HRB_slice_def)
next
  case (isSp_Append_cdep n ns nx n')
  note IH = S. n''  HRB_slice {n}; nx  S  n''  HRB_slice S
  from IH[OF n''  HRB_slice {n}] have "n''  HRB_slice {nx}" by simp
  thus ?case
  proof(induct rule:HRB_slice_cases)
    case (phase1 n nx') 
    from nx'  {nx} have "nx' = nx" by simp
    with n  sum_SDG_slice1 nx' nx s⟶cd n' have "n  sum_SDG_slice1 n'"
      by(fastforce intro:slice1_cdep_slice1)
    with n'  S show ?case
      by(fastforce intro:combine_SDG_slices.combSlice_refl simp:HRB_slice_def)
  next
    case (phase2 nx'' nx' n'' p n)
    from nx''  {nx} have "nx'' = nx" by simp
    with nx'  sum_SDG_slice1 nx'' nx s⟶cd n' have "nx'  sum_SDG_slice1 n'"
      by(fastforce intro:slice1_cdep_slice1)
    with n'' s-pret CFG_node (parent_node nx') n  sum_SDG_slice2 nx' n'  S
    show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node 
                            simp:HRB_slice_def)
  qed
next
  case (isSp_Append_ddep n ns nx V n')
  note IH = S. n''  HRB_slice {n}; nx  S  n''  HRB_slice S
  from IH[OF n''  HRB_slice {n}] have "n''  HRB_slice {nx}" by simp
  thus ?case
  proof(induct rule:HRB_slice_cases)
    case (phase1 n nx') 
    from nx'  {nx} have "nx' = nx" by simp
    with n  sum_SDG_slice1 nx' nx s-Vdd n' have "n  sum_SDG_slice1 n'"
      by(fastforce intro:slice1_ddep_slice1)
    with n'  S show ?case
      by(fastforce intro:combine_SDG_slices.combSlice_refl simp:HRB_slice_def)
  next
    case (phase2 nx'' nx' n'' p n)
    from nx''  {nx} have "nx'' = nx" by simp
    with nx'  sum_SDG_slice1 nx'' nx s-Vdd n' have "nx'  sum_SDG_slice1 n'"
      by(fastforce intro:slice1_ddep_slice1)
    with n'' s-pret CFG_node (parent_node nx') n  sum_SDG_slice2 nx' n'  S
    show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node 
                            simp:HRB_slice_def)
  qed
next
  case (isSp_Append_sum n ns nx p n')
  note IH = S. n''  HRB_slice {n}; nx  S  n''  HRB_slice S
  from IH[OF n''  HRB_slice {n}] have "n''  HRB_slice {nx}" by simp
  thus ?case
  proof(induct rule:HRB_slice_cases)
    case (phase1 n nx') 
    from nx'  {nx} have "nx' = nx" by simp
    with n  sum_SDG_slice1 nx' nx s-psum n' have "n  sum_SDG_slice1 n'"
      by(fastforce intro:slice1_sum_slice1)
    with n'  S show ?case
      by(fastforce intro:combine_SDG_slices.combSlice_refl simp:HRB_slice_def)
  next
    case (phase2 nx'' nx' n'' p' n)
    from nx''  {nx} have "nx'' = nx" by simp
    with nx'  sum_SDG_slice1 nx'' nx s-psum n' have "nx'  sum_SDG_slice1 n'"
      by(fastforce intro:slice1_sum_slice1)
    with n'' s-p'ret CFG_node (parent_node nx') n  sum_SDG_slice2 nx' n'  S
    show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node 
                            simp:HRB_slice_def)
  qed
qed


lemma call_return_nodes_in_slice:
  assumes "valid_edge a" and "kind a = Qpf"
  and "valid_edge a'" and "kind a' = Q':r'pfs'" and "a  get_return_edges a'"
  and "CFG_node (targetnode a)  HRB_slice S"
  shows "CFG_node (sourcenode a)  HRB_slice S"
  and "CFG_node (sourcenode a')  HRB_slice S" 
  and "CFG_node (targetnode a')  HRB_slice S"
proof -
  from valid_edge a' kind a' = Q':r'pfs' a  get_return_edges a'
  have "CFG_node (sourcenode a') s-psum CFG_node (targetnode a)"
    by(fastforce intro:sum_SDG_call_summary_edge)
  with ‹CFG_node (targetnode a)  HRB_slice S
  show "CFG_node (sourcenode a')  HRB_slice S"
    by(fastforce elim!:combine_SDG_slices.cases 
                intro:combine_SDG_slices.intros sum_slice1 sum_slice2 
                 simp:HRB_slice_def)
  from ‹CFG_node (targetnode a)  HRB_slice S
  obtain nc where "CFG_node (targetnode a)  combine_SDG_slices (sum_SDG_slice1 nc)"
    and "nc  S"
    by(simp add:HRB_slice_def) blast
  thus "CFG_node (sourcenode a)  HRB_slice S"
  proof(induct "CFG_node (targetnode a)" rule:combine_SDG_slices.induct)
    case combSlice_refl
    from valid_edge a kind a = Qpf
    have "CFG_node (sourcenode a) s-pret CFG_node (targetnode a)"
      by(fastforce intro:sum_SDG_return_edge)
    with valid_edge a 
    have "CFG_node (sourcenode a)  sum_SDG_slice2 (CFG_node (targetnode a))"
      by(fastforce intro:sum_SDG_slice2.intros)
    with ‹CFG_node (targetnode a)  sum_SDG_slice1 nc nc  S
      ‹CFG_node (sourcenode a) s-pret CFG_node (targetnode a)
    show ?case by(fastforce intro:combSlice_Return_parent_node simp:HRB_slice_def)
  next
    case (combSlice_Return_parent_node n' n'' p')
    from valid_edge a kind a = Qpf
    have "CFG_node (sourcenode a) s-pret CFG_node (targetnode a)"
      by(fastforce intro:sum_SDG_return_edge)
    with ‹CFG_node (targetnode a)  sum_SDG_slice2 n'
    have "CFG_node (sourcenode a)  sum_SDG_slice2 n'"
      by(fastforce intro:sum_SDG_slice2.intros)
    with n'  sum_SDG_slice1 nc n'' s-p'ret CFG_node (parent_node n') nc  S
    show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node 
                            simp:HRB_slice_def)
  qed
  from valid_edge a' kind a' = Q':r'pfs' a  get_return_edges a'
  have "CFG_node (targetnode a') s⟶cd CFG_node (sourcenode a)"
    by(fastforce intro:sum_SDG_proc_entry_exit_cdep)
  with ‹CFG_node (sourcenode a)  HRB_slice S nc  S
  show "CFG_node (targetnode a')  HRB_slice S"
    by(fastforce elim!:combine_SDG_slices.cases 
                intro:combine_SDG_slices.intros cdep_slice1 cdep_slice2 
                 simp:HRB_slice_def)
qed



subsection ‹Proof of Precision›


lemma in_intra_SDG_path_in_slice2:
  "n i-nsd* n'; n''  set ns  n''  sum_SDG_slice2 n'"
proof(induct rule:intra_SDG_path.induct)
  case iSp_Nil thus ?case by simp
next
  case (iSp_Append_cdep n ns nx n')
  note IH = n''  set ns  n''  sum_SDG_slice2 nx
  from n''  set (ns@[nx]) have "n''  set ns  n'' = nx" by auto
  thus ?case
  proof
    assume "n''  set ns"
    from IH[OF this] have "n''  sum_SDG_slice2 nx" by simp
    with nxcd n' show ?thesis
      by(fastforce intro:slice2_cdep_slice2 SDG_edge_sum_SDG_edge)
  next
    assume "n'' = nx"
    from nxcd n' have "valid_SDG_node n'" by(rule SDG_edge_valid_SDG_node)
    hence "n'  sum_SDG_slice2 n'" by(rule refl_slice2)
    with nxcd n' have "nx  sum_SDG_slice2 n'"
      by(fastforce intro:cdep_slice2 SDG_edge_sum_SDG_edge)
    with n'' = nx show ?thesis by simp
  qed
next
  case (iSp_Append_ddep n ns nx V n')
  note IH = n''  set ns  n''  sum_SDG_slice2 nx
  from n''  set (ns@[nx]) have "n''  set ns  n'' = nx" by auto
  thus ?case
  proof
    assume "n''  set ns"
    from IH[OF this] have "n''  sum_SDG_slice2 nx" by simp
    with nx -Vdd n' show ?thesis
      by(fastforce intro:slice2_ddep_slice2 SDG_edge_sum_SDG_edge)
  next
    assume "n'' = nx"
    from nx -Vdd n' have "valid_SDG_node n'" by(rule SDG_edge_valid_SDG_node)
    hence "n'  sum_SDG_slice2 n'" by(rule refl_slice2)
    with nx -Vdd n' have "nx  sum_SDG_slice2 n'"
      by(fastforce intro:ddep_slice2 SDG_edge_sum_SDG_edge)
    with n'' = nx show ?thesis by simp
  qed
qed


lemma in_intra_SDG_path_in_HRB_slice:
  "n i-nsd* n'; n''  set ns; n'  S  n''  HRB_slice S"
proof(induct arbitrary:S rule:intra_SDG_path.induct)
  case iSp_Nil thus ?case by simp
next
  case (iSp_Append_cdep n ns nx n')
  note IH = S. n''  set ns; nx  S  n''  HRB_slice S
  from n''  set (ns@[nx]) have "n''  set ns  n'' = nx" by auto
  thus ?case
  proof
    assume "n''  set ns"
    from IH[OF n''  set ns] have "n''  HRB_slice {nx}" by simp
    from this nxcd n' n'  S show ?case
      by(fastforce elim:HRB_slice_cases slice1_cdep_slice1
        intro:bexI[where x="n'"] combine_SDG_slices.intros SDG_edge_sum_SDG_edge 
        simp:HRB_slice_def)
  next
    assume "n'' = nx"
    from nxcd n' have "valid_SDG_node n'" by(rule SDG_edge_valid_SDG_node)
    hence "n'  sum_SDG_slice1 n'" by(rule refl_slice1)
    with nxcd n' have "nx  sum_SDG_slice1 n'" 
      by(fastforce intro:cdep_slice1 SDG_edge_sum_SDG_edge)
    with n'' = nx n'  S show ?case
      by(fastforce intro:combSlice_refl simp:HRB_slice_def)
  qed
next
  case (iSp_Append_ddep n ns nx V n')
  note IH = S. n''  set ns; nx  S  n''  HRB_slice S
  from n''  set (ns@[nx]) have "n''  set ns  n'' = nx" by auto
  thus ?case
  proof
    assume "n''  set ns"
    from IH[OF n''  set ns] have "n''  HRB_slice {nx}" by simp
    from this nx -Vdd n' n'  S show ?case
      by(fastforce elim:HRB_slice_cases slice1_ddep_slice1
        intro:bexI[where x="n'"] combine_SDG_slices.intros SDG_edge_sum_SDG_edge 
        simp:HRB_slice_def)
  next
    assume "n'' = nx"
    from nx -Vdd n' have "valid_SDG_node n'" by(rule SDG_edge_valid_SDG_node)
    hence "n'  sum_SDG_slice1 n'" by(rule refl_slice1)
    with nx -Vdd n' have "nx  sum_SDG_slice1 n'" 
      by(fastforce intro:ddep_slice1 SDG_edge_sum_SDG_edge)
    with n'' = nx n'  S show ?case 
      by(fastforce intro:combSlice_refl simp:HRB_slice_def)
  qed
qed


lemma in_matched_in_slice2:
  "matched n ns n'; n''  set ns  n''  sum_SDG_slice2 n'"
proof(induct rule:matched.induct)
  case matched_Nil thus ?case by simp
next
  case (matched_Append_intra_SDG_path n ns nx ns' n')
  note IH = n''  set ns  n''  sum_SDG_slice2 nx
  from n''  set (ns@ns') have "n''  set ns  n''  set ns'" by simp
  thus ?case
  proof
    assume "n''  set ns"
    from IH[OF this] have "n''  sum_SDG_slice2 nx" .
    with nx i-ns'd* n' show ?thesis
      by(fastforce intro:slice2_is_SDG_path_slice2 
                        intra_SDG_path_is_SDG_path)
  next
    assume "n''  set ns'"
    with nx i-ns'd* n' show ?case by(rule in_intra_SDG_path_in_slice2)
  qed
next
  case (matched_bracket_call n0 ns n1 p n2 ns' n3 n4 V a a')
  note IH1 = n''  set ns  n''  sum_SDG_slice2 n1
  note IH2 = n''  set ns'  n''  sum_SDG_slice2 n3
  from n1 -pcall n2 ‹matched n2 ns' n3 n3 -pret n4  n3 -p:Vout n4 
    a'  get_return_edges a valid_edge a
    sourcenode a = parent_node n1 targetnode a = parent_node n2
    sourcenode a' = parent_node n3 targetnode a' = parent_node n4
  have "matched n1 ([]@n1#ns'@[n3]) n4"
    by(fastforce intro:matched.matched_bracket_call matched_Nil 
                 elim:SDG_edge_valid_SDG_node)
  then obtain nsx where "n1 is-nsxd* n4" by(erule matched_is_SDG_path)
  from n''  set (ns@n1#ns'@[n3]) 
  have "((n''  set ns  n'' = n1)  n''  set ns')  n'' = n3" by auto
  thus ?case apply -
  proof(erule disjE)+
    assume "n''  set ns"
    from IH1[OF this] have "n''  sum_SDG_slice2 n1" .
    with n1 is-nsxd* n4 show ?thesis 
      by -(rule slice2_is_SDG_path_slice2)
  next
    assume "n'' = n1"
    from n1 is-nsxd* n4 have "n1  sum_SDG_slice2 n4" 
      by(fastforce intro:is_SDG_path_slice2 refl_slice2 is_SDG_path_valid_SDG_node)
    with n'' = n1 show ?thesis by(fastforce intro:combSlice_refl simp:HRB_slice_def)
  next
    assume "n''  set ns'"
    from IH2[OF this] have "n''  sum_SDG_slice2 n3" .
    with n3 -pret n4  n3 -p:Vout n4 show ?thesis 
      by(fastforce intro:slice2_ret_slice2 slice2_param_out_slice2 
                        SDG_edge_sum_SDG_edge)
  next
    assume "n'' = n3"
    from n3 -pret n4  n3 -p:Vout n4 have "n3 s-pret n4  n3 s-p:Vout n4" 
      by(fastforce intro:SDG_edge_sum_SDG_edge)
    hence "n3  sum_SDG_slice2 n4"
      by(fastforce intro:return_slice2 param_out_slice2 refl_slice2 
                        sum_SDG_edge_valid_SDG_node)
    with n'' = n3 show ?thesis by simp
  qed
next
  case (matched_bracket_param n0 ns n1 p V n2 ns' n3 V' n4 a a')
  note IH1 = n''  set ns  n''  sum_SDG_slice2 n1
  note IH2 = n''  set ns'  n''  sum_SDG_slice2 n3
  from n1 -p:Vin n2 ‹matched n2 ns' n3 n3 -p:V'out n4 
    a'  get_return_edges a valid_edge a
    sourcenode a = parent_node n1 targetnode a = parent_node n2
    sourcenode a' = parent_node n3 targetnode a' = parent_node n4
  have "matched n1 ([]@n1#ns'@[n3]) n4"
    by(fastforce intro:matched.matched_bracket_param matched_Nil 
                 elim:SDG_edge_valid_SDG_node)
  then obtain nsx where "n1 is-nsxd* n4" by(erule matched_is_SDG_path)
  from n''  set (ns@n1#ns'@[n3]) 
  have "((n''  set ns  n'' = n1)  n''  set ns')  n'' = n3" by auto
  thus ?case apply -
  proof(erule disjE)+
    assume "n''  set ns"
    from IH1[OF this] have "n''  sum_SDG_slice2 n1" .
    with n1 is-nsxd* n4 show ?thesis 
      by -(rule slice2_is_SDG_path_slice2)
  next
    assume "n'' = n1"
    from n1 is-nsxd* n4 have "n1  sum_SDG_slice2 n4" 
      by(fastforce intro:is_SDG_path_slice2 refl_slice2 is_SDG_path_valid_SDG_node)
    with n'' = n1 show ?thesis by(fastforce intro:combSlice_refl simp:HRB_slice_def)
  next
    assume "n''  set ns'"
    from IH2[OF this] have "n''  sum_SDG_slice2 n3" .
    with n3 -p:V'out n4 show ?thesis 
      by(fastforce intro:slice2_param_out_slice2 SDG_edge_sum_SDG_edge)
  next
    assume "n'' = n3"
    from n3 -p:V'out n4 have "n3 s-p:V'out n4" by(rule SDG_edge_sum_SDG_edge)
    hence "n3  sum_SDG_slice2 n4"
      by(fastforce intro:param_out_slice2 refl_slice2 sum_SDG_edge_valid_SDG_node)
    with n'' = n3 show ?thesis by simp
  qed
qed


lemma in_matched_in_HRB_slice:
  "matched n ns n'; n''  set ns; n'  S  n''  HRB_slice S"
proof(induct arbitrary:S rule:matched.induct)
   case matched_Nil thus ?case by simp
next
  case (matched_Append_intra_SDG_path n ns nx ns' n')
  note IH = S. n''  set ns; nx  S  n''  HRB_slice S
  from n''  set (ns@ns') have "n''  set ns  n''  set ns'" by simp
  thus ?case
  proof
    assume "n''  set ns"
    from IH[OF n''  set ns] have "n''  HRB_slice {nx}" by simp
    with nx i-ns'd* n' n'  S show ?thesis
      by(fastforce intro:HRB_slice_is_SDG_path_HRB_slice 
                        intra_SDG_path_is_SDG_path)
  next
    assume "n''  set ns'"
    with nx i-ns'd* n' n'  S show ?case 
      by(fastforce intro:in_intra_SDG_path_in_HRB_slice simp:HRB_slice_def)
  qed
next
  case (matched_bracket_call n0 ns n1 p n2 ns' n3 n4 V a a')
  note IH1 = S. n''  set ns; n1  S  n''  HRB_slice S
  note IH2 = S. n''  set ns'; n3  S  n''  HRB_slice S
  from n1 -pcall n2 ‹matched n2 ns' n3 n3 -pret n4  n3 -p:Vout n4 
    a'  get_return_edges a valid_edge a
    sourcenode a = parent_node n1 targetnode a = parent_node n2
    sourcenode a' = parent_node n3 targetnode a' = parent_node n4
  have "matched n1 ([]@n1#ns'@[n3]) n4"
    by(fastforce intro:matched.matched_bracket_call matched_Nil 
                 elim:SDG_edge_valid_SDG_node)
  then obtain nsx where "n1 is-nsxd* n4" by(erule matched_is_SDG_path)
  from n''  set (ns@n1#ns'@[n3]) 
  have "((n''  set ns  n'' = n1)  n''  set ns')  n'' = n3" by auto
  thus ?case apply -
  proof(erule disjE)+
    assume "n''  set ns"
    from IH1[OF this] have "n''  HRB_slice {n1}" by simp
    with n1 is-nsxd* n4 n4  S show ?thesis 
      by -(rule HRB_slice_is_SDG_path_HRB_slice)
  next
    assume "n'' = n1"
    from n1 is-nsxd* n4 have "n1  sum_SDG_slice1 n4" 
      by(fastforce intro:is_SDG_path_slice1 refl_slice1 is_SDG_path_valid_SDG_node)
    with n'' = n1 n4  S show ?thesis
      by(fastforce intro:combSlice_refl simp:HRB_slice_def)
  next
    assume "n''  set ns'"
    with ‹matched n2 ns' n3 have "n''  sum_SDG_slice2 n3"
      by(rule in_matched_in_slice2)
    with n3 -pret n4  n3 -p:Vout n4 have "n''  sum_SDG_slice2 n4"
      by(fastforce intro:slice2_ret_slice2 slice2_param_out_slice2 
                        SDG_edge_sum_SDG_edge)
    from n3 -pret n4  n3 -p:Vout n4 have "valid_SDG_node n4"
      by(fastforce intro:SDG_edge_valid_SDG_node)
    hence "n4  sum_SDG_slice1 n4" by(rule refl_slice1)
    from n3 -pret n4  n3 -p:Vout n4
    have "CFG_node (parent_node n3) -pret CFG_node (parent_node n4)"
      by(fastforce elim:SDG_edge.cases intro:SDG_return_edge)
    with n''  sum_SDG_slice2 n4 n4  sum_SDG_slice1 n4 n4  S
    show ?case by(fastforce intro:combSlice_Return_parent_node SDG_edge_sum_SDG_edge 
                            simp:HRB_slice_def)
  next
    assume "n'' = n3"
    from n3 -pret n4  n3 -p:Vout n4
    have "CFG_node (parent_node n3) -pret CFG_node (parent_node n4)"
      by(fastforce elim:SDG_edge.cases intro:SDG_return_edge)
    from n3 -pret n4  n3 -p:Vout n4 have "valid_SDG_node n4"
      by(fastforce intro:SDG_edge_valid_SDG_node)
    hence "n4  sum_SDG_slice1 n4" by(rule refl_slice1)
    from ‹valid_SDG_node n4 have "n4  sum_SDG_slice2 n4" by(rule refl_slice2)
    with n3 -pret n4  n3 -p:Vout n4 have "n3  sum_SDG_slice2 n4" 
      by(fastforce intro:return_slice2 param_out_slice2 SDG_edge_sum_SDG_edge)
    with n4  sum_SDG_slice1 n4 
      ‹CFG_node (parent_node n3) -pret CFG_node (parent_node n4) n'' = n3 n4  S
    show ?case by(fastforce intro:combSlice_Return_parent_node SDG_edge_sum_SDG_edge
                            simp:HRB_slice_def)
  qed
next
  case (matched_bracket_param n0 ns n1 p V n2 ns' n3 V' n4 a a')
  note IH1 = S. n''  set ns; n1  S  n''  HRB_slice S
  note IH2 = S. n''  set ns'; n3  S  n''  HRB_slice S
  from n1 -p:Vin n2 ‹matched n2 ns' n3 n3 -p:V'out n4 
    a'  get_return_edges a valid_edge a
    sourcenode a = parent_node n1 targetnode a = parent_node n2
    sourcenode a' = parent_node n3 targetnode a' = parent_node n4
  have "matched n1 ([]@n1#ns'@[n3]) n4"
    by(fastforce intro:matched.matched_bracket_param matched_Nil 
                 elim:SDG_edge_valid_SDG_node)
  then obtain nsx where "n1 is-nsxd* n4" by(erule matched_is_SDG_path)
  from n''  set (ns@n1#ns'@[n3]) 
  have "((n''  set ns  n'' = n1)  n''  set ns')  n'' = n3" by auto
  thus ?case apply -
  proof(erule disjE)+
    assume "n''  set ns"
    from IH1[OF this] have "n''  HRB_slice {n1}" by simp
    with n1 is-nsxd* n4 n4  S show ?thesis 
      by -(rule HRB_slice_is_SDG_path_HRB_slice)
  next
    assume "n'' = n1"
    from n1 is-nsxd* n4 have "n1  sum_SDG_slice1 n4"
      by(fastforce intro:is_SDG_path_slice1 refl_slice1 is_SDG_path_valid_SDG_node)
    with n'' = n1 n4  S show ?thesis
      by(fastforce intro:combSlice_refl simp:HRB_slice_def)
  next
    assume "n''  set ns'"
    with ‹matched n2 ns' n3 have "n''  sum_SDG_slice2 n3"
      by(rule in_matched_in_slice2)
    with n3 -p:V'out n4 have "n''  sum_SDG_slice2 n4"
      by(fastforce intro:slice2_param_out_slice2 SDG_edge_sum_SDG_edge)
    from n3 -p:V'out n4 have "valid_SDG_node n4" by(rule SDG_edge_valid_SDG_node)
    hence "n4  sum_SDG_slice1 n4" by(rule refl_slice1)
    from n3 -p:V'out n4 
    have "CFG_node (parent_node n3) -pret CFG_node (parent_node n4)"
      by(fastforce elim:SDG_edge.cases intro:SDG_return_edge)
    with n''  sum_SDG_slice2 n4 n4  sum_SDG_slice1 n4 n4  S
    show ?case by(fastforce intro:combSlice_Return_parent_node SDG_edge_sum_SDG_edge 
                            simp:HRB_slice_def)
  next
    assume "n'' = n3"
    from n3 -p:V'out n4 have "n3 s-p:V'out n4" by(rule SDG_edge_sum_SDG_edge)
    from n3 -p:V'out n4 have "valid_SDG_node n4" by(rule SDG_edge_valid_SDG_node)
    hence "n4  sum_SDG_slice1 n4" by(rule refl_slice1)
    from ‹valid_SDG_node n4 have "n4  sum_SDG_slice2 n4" by(rule refl_slice2)
    with n3 s-p:V'out n4 have "n3  sum_SDG_slice2 n4" by(rule param_out_slice2)
    from n3 -p:V'out n4 
    have "CFG_node (parent_node n3) -pret CFG_node (parent_node n4)"
      by(fastforce elim:SDG_edge.cases intro:SDG_return_edge)
    with n3  sum_SDG_slice2 n4 n4  sum_SDG_slice1 n4 n'' = n3 n4  S
    show ?case by(fastforce intro:combSlice_Return_parent_node SDG_edge_sum_SDG_edge
                            simp:HRB_slice_def)
  qed
qed


theorem in_realizable_in_HRB_slice:
  "realizable n ns n'; n''  set ns; n'  S  n''  HRB_slice S"
proof(induct arbitrary:S rule:realizable.induct)
  case (realizable_matched n ns n') thus ?case by(rule in_matched_in_HRB_slice)
next
  case (realizable_call n0 ns n1 p n2 V ns' n3)
  note IH = S. n''  set ns; n1  S  n''  HRB_slice S
  from n''  set (ns@n1#ns') have "(n''  set ns  n'' = n1)  n''  set ns'"
    by auto
  thus ?case apply -
  proof(erule disjE)+
    assume "n''  set ns"
    from IH[OF this] have "n''  HRB_slice {n1}" by simp
    hence "n''  HRB_slice {n2}"
    proof(induct rule:HRB_slice_cases)
      case (phase1 n nx)
      from nx  {n1} have "nx = n1" by simp
      with n  sum_SDG_slice1 nx n1 -pcall n2  n1 -p:Vin n2
      have "n  sum_SDG_slice1 n2" 
        by(fastforce intro:slice1_call_slice1 slice1_param_in_slice1 
                          SDG_edge_sum_SDG_edge)
      thus ?case
        by(fastforce intro:combine_SDG_slices.combSlice_refl simp:HRB_slice_def)
    next
      case (phase2 nx n' n'' p' n)
      from nx  {n1} have "nx = n1" by simp
      with n'  sum_SDG_slice1 nx n1 -pcall n2  n1 -p:Vin n2
      have "n'  sum_SDG_slice1 n2" 
        by(fastforce intro:slice1_call_slice1 slice1_param_in_slice1 
                          SDG_edge_sum_SDG_edge)
      with n'' s-p'ret CFG_node (parent_node n') n  sum_SDG_slice2 n' show ?case
        by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node 
                     simp:HRB_slice_def)
    qed
    from ‹matched n2 ns' n3 obtain nsx where "n2 is-nsxd* n3"
      by(erule matched_is_SDG_path)
    with n''  HRB_slice {n2} n3  S show ?thesis
      by(fastforce intro:HRB_slice_is_SDG_path_HRB_slice)
  next
    assume "n'' = n1"
    from ‹matched n2 ns' n3 obtain nsx where "n2 is-nsxd* n3"
      by(erule matched_is_SDG_path)
    hence "n2  sum_SDG_slice1 n2" 
      by(fastforce intro:refl_slice1 is_SDG_path_valid_SDG_node)
    with n1 -pcall n2  n1 -p:Vin n2
    have "n1  sum_SDG_slice1 n2"
      by(fastforce intro:call_slice1 param_in_slice1 SDG_edge_sum_SDG_edge)
    hence "n1  HRB_slice {n2}" by(fastforce intro:combSlice_refl simp:HRB_slice_def)
    with n2 is-nsxd* n3 n'' = n1 n3  S show ?thesis
      by(fastforce intro:HRB_slice_is_SDG_path_HRB_slice)
  next
    assume "n''  set ns'"
    from ‹matched n2 ns' n3 this n3  S show ?thesis
      by(rule in_matched_in_HRB_slice)
  qed
qed


lemma slice1_ics_SDG_path:
  assumes "n  sum_SDG_slice1 n'" and "n  n'"
  obtains ns where "CFG_node (_Entry_) ics-nsd* n'" and "n  set ns"
proof(atomize_elim)
  from n  sum_SDG_slice1 n' 
  have "n = n'  (ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns)"
  proof(induct rule:sum_SDG_slice1.induct)
    case refl_slice1 thus ?case by simp
  next
    case (cdep_slice1 n'' n)
    from n'' s⟶cd n have "valid_SDG_node n''" by(rule sum_SDG_edge_valid_SDG_node)
    hence "n'' ics-[]d* n''" by(rule icsSp_Nil)
    from ‹valid_SDG_node n'' have "valid_node (parent_node n'')"
      by(rule valid_SDG_CFG_node)
    thus ?case
    proof(cases "parent_node n'' = (_Exit_)")
      case True
      with ‹valid_SDG_node n'' have "n'' = CFG_node (_Exit_)"
        by(rule valid_SDG_node_parent_Exit)
      with n'' s⟶cd n have False by(fastforce intro:Exit_no_sum_SDG_edge_source)
      thus ?thesis by simp
    next
      case False
      from n'' s⟶cd n have "valid_SDG_node n''"
        by(rule sum_SDG_edge_valid_SDG_node)
      from this False obtain ns 
        where "CFG_node (_Entry_) cc-nsd* n''"
        by(erule Entry_cc_SDG_path_to_inner_node)
      with n'' s⟶cd n have "CFG_node (_Entry_) cc-ns@[n'']d* n"
        by(fastforce intro:ccSp_Append_cdep sum_SDG_edge_SDG_edge)
      hence "CFG_node (_Entry_) ics-ns@[n'']d* n"
        by(rule cc_SDG_path_ics_SDG_path)
      from n = n'  (ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns)
      show ?thesis
      proof
        assume "n = n'"
        with ‹CFG_node (_Entry_) ics-ns@[n'']d* n show ?thesis by fastforce
      next
        assume "ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns"
        then obtain nsx where "CFG_node (_Entry_) ics-nsxd* n'" and "n  set nsx"
          by blast
        then obtain ns' ns'' where "nsx = ns'@ns''" and "n ics-ns''d* n'"
          by -(erule ics_SDG_path_split)
        with ‹CFG_node (_Entry_) ics-ns@[n'']d* n
        show ?thesis by(fastforce intro:ics_SDG_path_Append)
      qed
    qed
  next
    case (ddep_slice1 n'' V n)
    from n'' s-Vdd n have "valid_SDG_node n''" by(rule sum_SDG_edge_valid_SDG_node)
    hence "n'' ics-[]d* n''" by(rule icsSp_Nil)
    from ‹valid_SDG_node n'' have "valid_node (parent_node n'')"
      by(rule valid_SDG_CFG_node)
    thus ?case
    proof(cases "parent_node n'' = (_Exit_)")
      case True
      with ‹valid_SDG_node n'' have "n'' = CFG_node (_Exit_)"
        by(rule valid_SDG_node_parent_Exit)
      with n'' s-Vdd n have False by(fastforce intro:Exit_no_sum_SDG_edge_source)
      thus ?thesis by simp
    next
      case False
      from n'' s-Vdd n have "valid_SDG_node n''"
        by(rule sum_SDG_edge_valid_SDG_node)
      from this False obtain ns 
        where "CFG_node (_Entry_) cc-nsd* n''"
        by(erule Entry_cc_SDG_path_to_inner_node)
     hence "CFG_node (_Entry_) ics-nsd* n''"
        by(rule cc_SDG_path_ics_SDG_path)
      show ?thesis
      proof(cases "n'' = n")
        case True
        from n = n'  (ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns)
        show ?thesis
        proof
          assume "n = n'"
          with n'' = n show ?thesis by simp
        next
          assume "ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns"
          with n'' = n show ?thesis by fastforce
        qed
      next
        case False
        with n'' s-Vdd n ‹CFG_node (_Entry_) ics-nsd* n''
        have "CFG_node (_Entry_) ics-ns@[n'']d* n"
          by -(rule icsSp_Append_ddep)
        from n = n'  (ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns)
        show ?thesis
        proof
          assume "n = n'"
          with ‹CFG_node (_Entry_) ics-ns@[n'']d* n show ?thesis by fastforce
        next
          assume "ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns"
          then obtain nsx where "CFG_node (_Entry_) ics-nsxd* n'" and "n  set nsx"
            by blast
          then obtain ns' ns'' where "nsx = ns'@ns''" and "n ics-ns''d* n'"
            by -(erule ics_SDG_path_split)
          with ‹CFG_node (_Entry_) ics-ns@[n'']d* n
          show ?thesis by(fastforce intro:ics_SDG_path_Append)
        qed
      qed
    qed
  next
    case (call_slice1 n'' p n)
    from n'' s-pcall n have "valid_SDG_node n''" 
      by(rule sum_SDG_edge_valid_SDG_node)
    hence "n'' ics-[]d* n''" by(rule icsSp_Nil)
    from ‹valid_SDG_node n'' have "valid_node (parent_node n'')"
      by(rule valid_SDG_CFG_node)
    thus ?case
    proof(cases "parent_node n'' = (_Exit_)")
      case True
      with ‹valid_SDG_node n'' have "n'' = CFG_node (_Exit_)"
        by(rule valid_SDG_node_parent_Exit)
      with n'' s-pcall n have False by(fastforce intro:Exit_no_sum_SDG_edge_source)
      thus ?thesis by simp
    next
      case False
      from n'' s-pcall n have "valid_SDG_node n''"
        by(rule sum_SDG_edge_valid_SDG_node)
      from this False obtain ns 
        where "CFG_node (_Entry_) cc-nsd* n''"
        by(erule Entry_cc_SDG_path_to_inner_node)
      with n'' s-pcall n have "CFG_node (_Entry_) cc-ns@[n'']d* n"
        by(fastforce intro:ccSp_Append_call sum_SDG_edge_SDG_edge)
      hence "CFG_node (_Entry_) ics-ns@[n'']d* n"
        by(rule cc_SDG_path_ics_SDG_path)
      from n = n'  (ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns)
      show ?thesis
      proof
        assume "n = n'"
        with ‹CFG_node (_Entry_) ics-ns@[n'']d* n show ?thesis by fastforce
      next
        assume "ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns"
        then obtain nsx where "CFG_node (_Entry_) ics-nsxd* n'" and "n  set nsx"
          by blast
        then obtain ns' ns'' where "nsx = ns'@ns''" and "n ics-ns''d* n'"
          by -(erule ics_SDG_path_split)
        with ‹CFG_node (_Entry_) ics-ns@[n'']d* n
        show ?thesis by(fastforce intro:ics_SDG_path_Append)
      qed
    qed
  next
    case (param_in_slice1 n'' p V n)
    from n'' s-p:Vin n have "valid_SDG_node n''" 
      by(rule sum_SDG_edge_valid_SDG_node)
    hence "n'' ics-[]d* n''" by(rule icsSp_Nil)
    from ‹valid_SDG_node n'' have "valid_node (parent_node n'')"
      by(rule valid_SDG_CFG_node)
    thus ?case
    proof(cases "parent_node n'' = (_Exit_)")
      case True
      with ‹valid_SDG_node n'' have "n'' = CFG_node (_Exit_)"
        by(rule valid_SDG_node_parent_Exit)
      with n'' s-p:Vin n have False by(fastforce intro:Exit_no_sum_SDG_edge_source)
      thus ?thesis by simp
    next
      case False
      from n'' s-p:Vin n have "valid_SDG_node n''"
        by(rule sum_SDG_edge_valid_SDG_node)
      from this False obtain ns 
        where "CFG_node (_Entry_) cc-nsd* n''"
        by(erule Entry_cc_SDG_path_to_inner_node)
      hence "CFG_node (_Entry_) ics-nsd* n''"
        by(rule cc_SDG_path_ics_SDG_path)
      with n'' s-p:Vin n have "CFG_node (_Entry_) ics-ns@[n'']d* n"
        by -(rule icsSp_Append_param_in)
      from n = n'  (ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns)
      show ?thesis
      proof
        assume "n = n'"
        with ‹CFG_node (_Entry_) ics-ns@[n'']d* n show ?thesis by fastforce
      next
        assume "ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns"
        then obtain nsx where "CFG_node (_Entry_) ics-nsxd* n'" and "n  set nsx"
          by blast
        then obtain ns' ns'' where "nsx = ns'@ns''" and "n ics-ns''d* n'"
          by -(erule ics_SDG_path_split)
        with ‹CFG_node (_Entry_) ics-ns@[n'']d* n
        show ?thesis by(fastforce intro:ics_SDG_path_Append)
      qed
    qed
  next
    case (sum_slice1 n'' p n)
    from n'' s-psum n have "valid_SDG_node n''" 
      by(rule sum_SDG_edge_valid_SDG_node)
    hence "n'' ics-[]d* n''" by(rule icsSp_Nil)
    from ‹valid_SDG_node n'' have "valid_node (parent_node n'')"
      by(rule valid_SDG_CFG_node)
    thus ?case
    proof(cases "parent_node n'' = (_Exit_)")
      case True
      with ‹valid_SDG_node n'' have "n'' = CFG_node (_Exit_)"
        by(rule valid_SDG_node_parent_Exit)
      with n'' s-psum n have False by(fastforce intro:Exit_no_sum_SDG_edge_source)
      thus ?thesis by simp
    next
      case False
      from n'' s-psum n have "valid_SDG_node n''"
        by(rule sum_SDG_edge_valid_SDG_node)
      from this False obtain ns 
        where "CFG_node (_Entry_) cc-nsd* n''"
        by(erule Entry_cc_SDG_path_to_inner_node)
      hence "CFG_node (_Entry_) ics-nsd* n''"
        by(rule cc_SDG_path_ics_SDG_path)
      with n'' s-psum n have "CFG_node (_Entry_) ics-ns@[n'']d* n"
        by -(rule icsSp_Append_sum)
      from n = n'  (ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns)
      show ?thesis
      proof
        assume "n = n'"
        with ‹CFG_node (_Entry_) ics-ns@[n'']d* n show ?thesis by fastforce
      next
        assume "ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns"
        then obtain nsx where "CFG_node (_Entry_) ics-nsxd* n'" and "n  set nsx"
          by blast
        then obtain ns' ns'' where "nsx = ns'@ns''" and "n ics-ns''d* n'"
          by -(erule ics_SDG_path_split)
        with ‹CFG_node (_Entry_) ics-ns@[n'']d* n
        show ?thesis by(fastforce intro:ics_SDG_path_Append)
      qed
    qed
  qed
  with n  n' show "ns. CFG_node (_Entry_) ics-nsd* n'  n  set ns" by simp
qed


lemma slice2_irs_SDG_path:
  assumes "n  sum_SDG_slice2 n'" and "valid_SDG_node n'"
  obtains ns where "n irs-nsd* n'"
using assms
by(induct rule:sum_SDG_slice2.induct,auto intro:intra_return_sum_SDG_path.intros)


theorem HRB_slice_realizable:
  assumes "n  HRB_slice S" and "n'  S. valid_SDG_node n'" and "n  S"
  obtains n' ns where "n'  S" and "realizable (CFG_node (_Entry_)) ns n'" 
  and "n  set ns"
proof(atomize_elim)
  from n  HRB_slice S n  S
  show "n' ns. n'  S  realizable (CFG_node (_Entry_)) ns n'  n  set ns"
  proof(induct rule:HRB_slice_cases)
    case (phase1 n nx)
    with n  S show ?case
      by(fastforce elim:slice1_ics_SDG_path ics_SDG_path_realizable)
  next
    case (phase2 n' nx n'' p n)
    from n'  S. valid_SDG_node n' n'  S have "valid_SDG_node n'" by simp
    with nx  sum_SDG_slice1 n' have "valid_SDG_node nx"
      by(auto elim:slice1_ics_SDG_path ics_SDG_path_split 
              intro:ics_SDG_path_valid_SDG_node)
    with n  sum_SDG_slice2 nx
    obtain nsx where "n irs-nsxd* nx" by(erule slice2_irs_SDG_path)
    show ?case
    proof(cases "n = nx")
      case True
      show ?thesis
      proof(cases "nx = n'")
        case True
        with n = nx n  S n'  S have False by simp
        thus ?thesis by simp
      next
        case False
        with nx  sum_SDG_slice1 n' obtain ns 
          where "realizable (CFG_node (_Entry_)) ns n'" and "nx  set ns"
          by(fastforce elim:slice1_ics_SDG_path ics_SDG_path_realizable)
        with n = nx n'  S show ?thesis by blast
      qed
    next
      case False
      with n irs-nsxd* nx obtain ns
        where "realizable (CFG_node (_Entry_)) ns nx" and "n  set ns"
        by(erule irs_SDG_path_realizable)
      show ?thesis
      proof(cases "nx = n'")
        case True
        with ‹realizable (CFG_node (_Entry_)) ns nx n  set ns n'  S
        show ?thesis by blast
      next
        case False
        with nx  sum_SDG_slice1 n' obtain nsx'
          where "CFG_node (_Entry_) ics-nsx'd* n'" and "nx  set nsx'"
          by(erule slice1_ics_SDG_path)
        then obtain ns' where "nx ics-ns'd* n'" by -(erule ics_SDG_path_split)
        with ‹realizable (CFG_node (_Entry_)) ns nx
        obtain ns'' where "realizable (CFG_node (_Entry_)) (ns@ns'') n'"
          by(erule realizable_Append_ics_SDG_path)
        with n  set ns n'  S show ?thesis by fastforce
      qed
    qed
  qed
qed


theorem HRB_slice_precise:
  "n'  S. valid_SDG_node n'; n  S 
    n  HRB_slice S = 
    (n' ns. n'  S  realizable (CFG_node (_Entry_)) ns n'  n  set ns)"
  by(fastforce elim:HRB_slice_realizable intro:in_realizable_in_HRB_slice)

end

end

Theory SCDObservable

section ‹Observable sets w.r.t.\ standard control dependence›

theory SCDObservable imports Observable HRBSlice begin

context SDG begin

lemma matched_bracket_assms_variant:
  assumes "n1 -pcall n2  n1 -p:V'in n2" and "matched n2 ns' n3" 
  and "n3 -pret n4  n3 -p:Vout n4"
  and "call_of_return_node (parent_node n4) (parent_node n1)"
  obtains a a' where "valid_edge a" and "a'  get_return_edges a"
  and "sourcenode a = parent_node n1" and "targetnode a = parent_node n2"
  and "sourcenode a' = parent_node n3" and "targetnode a' = parent_node n4"
proof(atomize_elim)
  from n1 -pcall n2  n1 -p:V'in n2 obtain a Q r fs where "valid_edge a" 
    and "kind a = Q:rpfs" and "parent_node n1 = sourcenode a"
    and "parent_node n2 = targetnode a"
    by(fastforce elim:SDG_edge.cases)
  from n3 -pret n4  n3 -p:Vout n4 obtain a' Q' f'
    where "valid_edge a'" and "kind a' = Q'pf'"
    and "parent_node n3 = sourcenode a'" and "parent_node n4 = targetnode a'"
    by(fastforce elim:SDG_edge.cases)
  from valid_edge a' kind a' = Q'pf'
  obtain ax where "valid_edge ax" and "Q r fs. kind ax = Q:rpfs"
    and "a'  get_return_edges ax"
    by -(drule return_needs_call,fastforce+)
  from valid_edge a valid_edge ax kind a = Q:rpfs Q r fs. kind ax = Q:rpfs
  have "targetnode a = targetnode ax" by(fastforce dest:same_proc_call_unique_target)
  from valid_edge a' a'  get_return_edges ax valid_edge ax
  have "call_of_return_node (targetnode a') (sourcenode ax)"
    by(fastforce simp:return_node_def call_of_return_node_def)
  with ‹call_of_return_node (parent_node n4) (parent_node n1) 
    ‹parent_node n4 = targetnode a'
  have "sourcenode ax = parent_node n1" by fastforce
  with valid_edge ax a'  get_return_edges ax targetnode a = targetnode ax
    ‹parent_node n2 = targetnode a ‹parent_node n3 = sourcenode a' 
    ‹parent_node n4 = targetnode a'
  show "a a'. valid_edge a  a'  get_return_edges a 
    sourcenode a = parent_node n1  targetnode a = parent_node n2 
    sourcenode a' = parent_node n3  targetnode a' = parent_node n4"
    by fastforce
qed

subsection ‹Observable set of standard control dependence is at most a singleton›

definition SDG_to_CFG_set :: "'node SDG_node set  'node set" ("_CFG")
  where "SCFG  {m. CFG_node m  S}"


lemma [intro]:"n  S. valid_SDG_node n  n  SCFG. valid_node n"
  by(fastforce simp:SDG_to_CFG_set_def)


lemma Exit_HRB_Slice:
  assumes "n  HRB_slice {CFG_node (_Exit_)}CFG" shows "n = (_Exit_)"
proof -
  from n  HRB_slice {CFG_node (_Exit_)}CFG 
  have "CFG_node n  HRB_slice {CFG_node (_Exit_)}"
    by(simp add:SDG_to_CFG_set_def)
  thus ?thesis
  proof(induct "CFG_node n" rule:HRB_slice_cases)
    case (phase1 nx)
    from nx  {CFG_node (_Exit_)} have "nx = CFG_node (_Exit_)" by simp
    with ‹CFG_node n  sum_SDG_slice1 nx
    have "CFG_node n = CFG_node (_Exit_)  
      (n Vopt popt b. sum_SDG_edge n Vopt popt b (CFG_node (_Exit_)))"
      by(induct rule:sum_SDG_slice1.induct) auto
    then show ?thesis by(fastforce dest:Exit_no_sum_SDG_edge_target)
  next
    case (phase2 nx n' n'' p)
    from nx  {CFG_node (_Exit_)} have "nx = CFG_node (_Exit_)" by simp
    with n'  sum_SDG_slice1 nx
    have "n' = CFG_node (_Exit_)  
      (n Vopt popt b. sum_SDG_edge n Vopt popt b (CFG_node (_Exit_)))"
      by(induct rule:sum_SDG_slice1.induct) auto
    hence "n' = CFG_node (_Exit_)" by(fastforce dest:Exit_no_sum_SDG_edge_target)
    with ‹CFG_node n  sum_SDG_slice2 n'
    have "CFG_node n = CFG_node (_Exit_)  
      (n Vopt popt b. sum_SDG_edge n Vopt popt b (CFG_node (_Exit_)))"
      by(induct rule:sum_SDG_slice2.induct) auto
    then show ?thesis by(fastforce dest:Exit_no_sum_SDG_edge_target)
  qed
qed


lemma Exit_in_obs_intra_slice_node:
  assumes "(_Exit_)  obs_intra n' HRB_slice SCFG"
  shows "CFG_node (_Exit_)  S"
proof -
  let ?S' = "HRB_slice SCFG"
  from (_Exit_)  obs_intra n' ?S' obtain as where "n' -asι* (_Exit_)"
    and "nx  set(sourcenodes as). nx  ?S'" and "(_Exit_)  ?S'"
    by(erule obs_intraE)
  from (_Exit_)  ?S' 
  have "CFG_node (_Exit_)  HRB_slice S" by(simp add:SDG_to_CFG_set_def)
  thus ?thesis
  proof(induct "CFG_node (_Exit_)" rule:HRB_slice_cases)
    case (phase1 nx)
    thus ?case
      by(induct "CFG_node (_Exit_)" rule:sum_SDG_slice1.induct,
        auto dest:Exit_no_sum_SDG_edge_source)
  next
    case (phase2 nx n' n'' p)
    from ‹CFG_node (_Exit_)  sum_SDG_slice2 n' n'  sum_SDG_slice1 nx nx  S
    show ?case
      apply(induct n"CFG_node (_Exit_)" rule:sum_SDG_slice2.induct)
      apply(auto dest:Exit_no_sum_SDG_edge_source)
      apply(hypsubst_thin)
      apply(induct n"CFG_node (_Exit_)" rule:sum_SDG_slice1.induct)
      apply(auto dest:Exit_no_sum_SDG_edge_source)
      done
  qed
qed


lemma obs_intra_postdominate:
  assumes "n  obs_intra n' HRB_slice SCFG" and "¬ method_exit n"
  shows "n postdominates n'"
proof(rule ccontr)
  assume "¬ n postdominates n'"
  from n  obs_intra n' HRB_slice SCFG have "valid_node n" 
    by(fastforce dest:in_obs_intra_valid)
  with n  obs_intra n' HRB_slice SCFG ¬ method_exit n have "n postdominates n"
    by(fastforce intro:postdominate_refl)
  from n  obs_intra n' HRB_slice SCFG obtain as where "n' -asι* n"
    and all_notinS:"n'  set(sourcenodes as). n'  HRB_slice SCFG"
    and "n  HRB_slice SCFG" by(erule obs_intraE)
  from n postdominates n ¬ n postdominates n' n' -asι* n
  obtain as' a as'' where [simp]:"as = as'@a#as''"
    and "valid_edge a" and "¬ n postdominates (sourcenode a)"
    and "n postdominates (targetnode a)"  and "intra_kind (kind a)"
    by(fastforce elim!:postdominate_path_branch simp:intra_path_def)
  from n' -asι* n have "sourcenode a -a#as''ι* n"
    by(fastforce elim:path_split intro:Cons_path simp:intra_path_def)
  with ¬ n postdominates (sourcenode a) valid_edge a ‹valid_node n 
  obtain asx pex where "sourcenode a -asxι* pex" and "method_exit pex" 
    and "n  set(sourcenodes asx)" by(fastforce simp:postdominate_def)
  have "asx  []"
  proof
    assume "asx = []"
    with sourcenode a -asxι* pex have "sourcenode a = pex" 
      by(fastforce simp:intra_path_def)
    from ‹method_exit pex show False
    proof(rule method_exit_cases)
      assume "pex = (_Exit_)"
      with sourcenode a = pex have "sourcenode a = (_Exit_)" by simp
      with valid_edge a show False by(rule Exit_source)
    next
      fix a' Q f p
      assume "pex = sourcenode a'" and "valid_edge a'" and "kind a' = Qpf"
      from valid_edge a' kind a' = Qpf valid_edge a ‹intra_kind (kind a)
        sourcenode a = pex pex = sourcenode a'
      show False by(fastforce dest:return_edges_only simp:intra_kind_def)
    qed
  qed
  then obtain ax asx' where [simp]:"asx = ax#asx'" by(cases asx) auto
  with sourcenode a -asxι* pex have "sourcenode a -ax#asx'→* pex"
    by(simp add:intra_path_def)
  hence "valid_edge ax" and [simp]:"sourcenode a = sourcenode ax"
    and "targetnode ax -asx'→* pex" by(auto elim:path_split_Cons)
  with sourcenode a -asxι* pex have "targetnode ax -asx'ι* pex"
    by(simp add:intra_path_def)
  with valid_edge ax n  set(sourcenodes asx) ‹method_exit pex
  have "¬ n postdominates targetnode ax"
    by(fastforce simp:postdominate_def sourcenodes_def)
  from n  obs_intra n' HRB_slice SCFG all_notinS 
  have "n  set (sourcenodes (a#as''))"
    by(fastforce elim:obs_intra.cases simp:sourcenodes_def)
  from sourcenode a -asxι* pex have "intra_kind (kind ax)"
    by(simp add:intra_path_def)
  with sourcenode a -a#as''ι* n n postdominates (targetnode a) 
    ¬ n postdominates targetnode ax valid_edge ax 
    n  set (sourcenodes (a#as'')) ‹intra_kind (kind a)
  have "(sourcenode a) controls n"
    by(fastforce simp:control_dependence_def)
  hence "CFG_node (sourcenode a) s⟶cd CFG_node n"
    by(fastforce intro:sum_SDG_cdep_edge)
  with n  obs_intra n' HRB_slice SCFG have "sourcenode a  HRB_slice SCFG"
    by(auto elim!:obs_intraE combine_SDG_slices.cases 
            intro:combine_SDG_slices.intros sum_SDG_slice1.intros 
                  sum_SDG_slice2.intros simp:HRB_slice_def SDG_to_CFG_set_def)
  with all_notinS show False by(simp add:sourcenodes_def)
qed



lemma obs_intra_singleton_disj: 
  assumes "valid_node n"
  shows "(m. obs_intra n HRB_slice SCFG = {m})  
         obs_intra n HRB_slice SCFG = {}"
proof(rule ccontr)
  assume "¬ ((m. obs_intra n HRB_slice SCFG = {m})  
             obs_intra n HRB_slice SCFG = {})"
  hence "nx nx'. nx  obs_intra n HRB_slice SCFG  
    nx'  obs_intra n HRB_slice SCFG  nx  nx'" by auto
  then obtain nx nx' where "nx  obs_intra n HRB_slice SCFG" 
    and "nx'  obs_intra n HRB_slice SCFG" and "nx  nx'" by auto
  from nx  obs_intra n HRB_slice SCFG obtain as where "n -asι* nx" 
    and all:"n'  set(sourcenodes as). n'  HRB_slice SCFG" 
    and "nx  HRB_slice SCFG" 
    by(erule obs_intraE)
  from n -asι* nx have "n -as→* nx" and "a  set as. intra_kind (kind a)"
    by(simp_all add:intra_path_def)
  hence "valid_node nx" by(fastforce dest:path_valid_node)
  with nx  HRB_slice SCFG have "obs_intra nx HRB_slice SCFG = {nx}" 
    by -(rule n_in_obs_intra)
  with n -as→* nx nx  obs_intra n HRB_slice SCFG 
    nx'  obs_intra n HRB_slice SCFG nx  nx' have "as  []" 
    by(fastforce elim:path.cases simp:intra_path_def)
  with n -as→* nx nx  obs_intra n HRB_slice SCFG 
    nx'  obs_intra n HRB_slice SCFG nx  nx' 
    ‹obs_intra nx HRB_slice SCFG = {nx} a  set as. intra_kind (kind a) all
  have "a as' as''. n -as'ι* sourcenode a  targetnode a -as''ι* nx 
                     valid_edge a  as = as'@a#as''  intra_kind (kind a) 
                     obs_intra (targetnode a) HRB_slice SCFG = {nx}  
                    (¬ (m. obs_intra (sourcenode a) HRB_slice SCFG = {m}  
                       obs_intra (sourcenode a) HRB_slice SCFG = {}))"
  proof(induct arbitrary:nx' rule:path.induct)
    case (Cons_path n'' as n' a n)
    note IH = nx'. n'  obs_intra n'' HRB_slice SCFG; 
                       nx'  obs_intra n'' HRB_slice SCFG; n'  nx'; 
                       obs_intra n' HRB_slice SCFG = {n'};
                       aset as. intra_kind (kind a);
                       n'set (sourcenodes as). n'  HRB_slice SCFG; as  []
       a as' as''. n'' -as'ι* sourcenode a  targetnode a -as''ι* n' 
        valid_edge a  as = as'@a#as''  intra_kind (kind a) 
        obs_intra (targetnode a) HRB_slice SCFG = {n'} 
        (¬ (m. obs_intra (sourcenode a) HRB_slice SCFG = {m}  
           obs_intra (sourcenode a) HRB_slice SCFG = {}))
    note more_than_one = n'  obs_intra n HRB_slice SCFG
      nx'  obs_intra n HRB_slice SCFG n'  nx'
    from aset (a#as). intra_kind (kind a)
    have "aset as. intra_kind (kind a)" and "intra_kind (kind a)" by simp_all
    from n'set (sourcenodes (a#as)). n'  HRB_slice SCFG
    have all:"n'set (sourcenodes as). n'  HRB_slice SCFG"
      by(simp add:sourcenodes_def)
    show ?case
    proof(cases "as = []")
      case True
      with n'' -as→* n' have [simp]:"n'' = n'" by(fastforce elim:path.cases)
      from more_than_one sourcenode a = n
      have "¬ (m. obs_intra (sourcenode a) HRB_slice SCFG = {m}  
               obs_intra (sourcenode a) HRB_slice SCFG = {})"
        by auto
      with targetnode a = n'' ‹obs_intra n' HRB_slice SCFG = {n'}
        sourcenode a = n True valid_edge a ‹intra_kind (kind a) 
      show ?thesis
        apply(rule_tac x="a" in exI)
        apply(rule_tac x="[]" in exI)
        apply(rule_tac x="[]" in exI)
        by(auto intro:empty_path simp:intra_path_def)
    next
      case False
      from n'' -as→* n' aset (a # as). intra_kind (kind a)
      have "n'' -asι* n'" by(simp add:intra_path_def)
      with all 
      have subset:"obs_intra n' HRB_slice SCFG  obs_intra n'' HRB_slice SCFG"
        by -(rule path_obs_intra_subset)
      thus ?thesis
      proof(cases "obs_intra n' HRB_slice SCFG = obs_intra n'' HRB_slice SCFG")
        case True
        with n'' -asι* n' valid_edge a sourcenode a = n targetnode a = n''
          ‹obs_intra n' HRB_slice SCFG = {n'} ‹intra_kind (kind a) more_than_one
        show ?thesis
          apply(rule_tac x="a" in exI)
          apply(rule_tac x="[]" in exI)
          apply(rule_tac x="as" in exI)
          by(fastforce intro:empty_path simp:intra_path_def)
      next
        case False
        with subset
        have "obs_intra n' HRB_slice SCFG  obs_intra n'' HRB_slice SCFG" by simp
        with ‹obs_intra n' HRB_slice SCFG = {n'} 
        obtain ni where "n'  obs_intra n'' HRB_slice SCFG"
          and "ni  obs_intra n'' HRB_slice SCFG" and "n'  ni" by auto
        from IH[OF this ‹obs_intra n' HRB_slice SCFG = {n'} 
          aset as. intra_kind (kind a) all as  []] obtain a' as' as''
          where "n'' -as'ι* sourcenode a'" 
          and hyps:"targetnode a' -as''ι* n'" "valid_edge a'" "as = as'@a'#as''" 
            "intra_kind (kind a')" "obs_intra (targetnode a') HRB_slice SCFG = {n'}"
            "¬ (m. obs_intra (sourcenode a') HRB_slice SCFG = {m}  
                                obs_intra (sourcenode a') HRB_slice SCFG = {})"
          by blast
        from n'' -as'ι* sourcenode a' valid_edge a sourcenode a = n 
          targetnode a = n'' ‹intra_kind (kind a) ‹intra_kind (kind a')
        have "n -a#as'ι* sourcenode a'"
          by(fastforce intro:path.Cons_path simp:intra_path_def)
        with hyps show ?thesis
          apply(rule_tac x="a'" in exI)
          apply(rule_tac x="a#as'" in exI)
          apply(rule_tac x="as''" in exI)
          by fastforce
      qed
    qed
  qed simp
  then obtain a as' as'' where "valid_edge a" and "intra_kind (kind a)"
    and "obs_intra (targetnode a) HRB_slice SCFG = {nx}"
    and more_than_one:"¬ (m. obs_intra (sourcenode a) HRB_slice SCFG = {m}  
                         obs_intra (sourcenode a) HRB_slice SCFG = {})"
    by blast
  have "sourcenode a  HRB_slice SCFG"
  proof(rule ccontr)
    assume "¬ sourcenode a  HRB_slice SCFG"
    hence "sourcenode a  HRB_slice SCFG" by simp
    with valid_edge a
    have "obs_intra (sourcenode a) HRB_slice SCFG = {sourcenode a}"
      by(fastforce intro!:n_in_obs_intra)
    with more_than_one show False by simp
  qed
  with valid_edge a ‹intra_kind (kind a)
  have "obs_intra (targetnode a) HRB_slice SCFG  
        obs_intra (sourcenode a) HRB_slice SCFG"
    by(rule edge_obs_intra_subset)
  with ‹obs_intra (targetnode a) HRB_slice SCFG = {nx} 
  have "nx  obs_intra (sourcenode a) HRB_slice SCFG" by simp
  with more_than_one obtain m 
    where "m  obs_intra (sourcenode a) HRB_slice SCFG" and "nx  m" by auto
  from m  obs_intra (sourcenode a) HRB_slice SCFG have "valid_node m" 
    by(fastforce dest:in_obs_intra_valid)
  from ‹obs_intra (targetnode a) HRB_slice SCFG = {nx} have "valid_node nx"
    by(fastforce dest:in_obs_intra_valid)
  show False
  proof(cases "m postdominates (sourcenode a)")
    case True
    with nx  obs_intra (sourcenode a) HRB_slice SCFG
      m  obs_intra (sourcenode a) HRB_slice SCFG
    have "m postdominates nx"
      by(fastforce intro:postdominate_inner_path_targetnode elim:obs_intraE)
    with nx  m have "¬ nx postdominates m" by(fastforce dest:postdominate_antisym)
    with ‹valid_node nx ‹valid_node m obtain asx pex where "m -asxι* pex"
      and "method_exit pex" and "nx  set(sourcenodes asx)"
      by(fastforce simp:postdominate_def)
    have "¬ nx postdominates (sourcenode a)"
    proof
      assume "nx postdominates sourcenode a"
      from nx  obs_intra (sourcenode a) HRB_slice SCFG
        m  obs_intra (sourcenode a) HRB_slice SCFG
      obtain asx' where "sourcenode a -asx'ι* m" and "nx  set(sourcenodes asx')"
        by(fastforce elim:obs_intraE)
      with m -asxι* pex have "sourcenode a -asx'@asxι* pex"
        by(fastforce intro:path_Append simp:intra_path_def)
      with nx  set(sourcenodes asx) nx  set(sourcenodes asx') 
        nx postdominates sourcenode a ‹method_exit pex show False
        by(fastforce simp:sourcenodes_def postdominate_def)
    qed
    show False
    proof(cases "method_exit nx")
      case True
      from m postdominates nx obtain xs where "nx -xsι* m"
        by -(erule postdominate_implies_inner_path)
      with True have "nx = m"
        by(fastforce dest!:method_exit_inner_path simp:intra_path_def)
      with nx  m show False by simp
    next
      case False
      with nx  obs_intra (sourcenode a) HRB_slice SCFG
      have "nx postdominates sourcenode a" by(rule obs_intra_postdominate)
      with ¬ nx postdominates (sourcenode a) show False by simp
    qed
  next
    case False
    show False
    proof(cases "method_exit m")
      case True
      from m  obs_intra (sourcenode a) HRB_slice SCFG
        nx  obs_intra (sourcenode a) HRB_slice SCFG
      obtain xs where "sourcenode a -xsι* m" and "nx  set(sourcenodes xs)"
        by(fastforce elim:obs_intraE)
      obtain x' xs' where [simp]:"xs = x'#xs'"
      proof(cases xs)
        case Nil
        with sourcenode a -xsι* m have [simp]:"sourcenode a = m"
          by(fastforce simp:intra_path_def)
        with m  obs_intra (sourcenode a) HRB_slice SCFG 
        have "m  HRB_slice SCFG" by(metis obs_intraE)
        with ‹valid_node m have "obs_intra m HRB_slice SCFG = {m}"
          by(rule n_in_obs_intra)
        with nx  obs_intra (sourcenode a) HRB_slice SCFG nx  m have False
          by fastforce
        thus ?thesis by simp
      qed blast
      from sourcenode a -xsι* m have "sourcenode a = sourcenode x'" 
        and "valid_edge x'" and "targetnode x' -xs'ι* m"
        and "intra_kind (kind x')"
        by(auto elim:path_split_Cons simp:intra_path_def)
      from targetnode x' -xs'ι* m nx  set(sourcenodes xs) valid_edge x' 
        ‹valid_node m True
      have "¬ nx postdominates (targetnode x')" 
        by(fastforce simp:postdominate_def sourcenodes_def)
      show False
      proof(cases "method_exit nx")
        case True
        from m  obs_intra (sourcenode a) HRB_slice SCFG
          nx  obs_intra (sourcenode a) HRB_slice SCFG
        have "get_proc m = get_proc nx"
          by(fastforce elim:obs_intraE dest:intra_path_get_procs)
        with ‹method_exit m ‹method_exit nx have "m = nx"
          by(rule method_exit_unique)
        with nx  m show False by simp
      next 
        case False
        with ‹obs_intra (targetnode a) HRB_slice SCFG = {nx}
        have "nx postdominates (targetnode a)"
          by(fastforce intro:obs_intra_postdominate)
        from ‹obs_intra (targetnode a) HRB_slice SCFG = {nx}
        obtain ys where "targetnode a -ysι* nx" 
          and "nx'  set(sourcenodes ys). nx'  HRB_slice SCFG"
          and "nx  HRB_slice SCFG" by(fastforce elim:obs_intraE)
        hence "nx  set(sourcenodes ys)"by fastforce
        have "sourcenode a  nx"
        proof
          assume "sourcenode a = nx"
          from nx  obs_intra (sourcenode a) HRB_slice SCFG
          have "nx  HRB_slice SCFG" by -(erule obs_intraE)
          with ‹valid_node nx
          have "obs_intra nx HRB_slice SCFG = {nx}" by -(erule n_in_obs_intra)
          with sourcenode a = nx m  obs_intra (sourcenode a) HRB_slice SCFG 
            nx  m show False by fastforce
        qed
        with nx  set(sourcenodes ys) have "nx  set(sourcenodes (a#ys))"
          by(fastforce simp:sourcenodes_def)
        from valid_edge a targetnode a -ysι* nx ‹intra_kind (kind a)
        have "sourcenode a -a#ysι* nx"
          by(fastforce intro:Cons_path simp:intra_path_def)
        from sourcenode a -a#ysι* nx nx  set(sourcenodes (a#ys))
          ‹intra_kind (kind a) nx postdominates (targetnode a)
          valid_edge x' ‹intra_kind (kind x') ¬ nx postdominates (targetnode x')
          sourcenode a = sourcenode x'
        have "(sourcenode a) controls nx"
          by(fastforce simp:control_dependence_def)
        hence "CFG_node (sourcenode a)cd CFG_node nx" 
          by(fastforce intro:SDG_cdep_edge)
        with nx  HRB_slice SCFG have "sourcenode a  HRB_slice SCFG"
          by(fastforce elim!:combine_SDG_slices.cases
                       dest:SDG_edge_sum_SDG_edge cdep_slice1 cdep_slice2 
                      intro:combine_SDG_slices.intros
                       simp:HRB_slice_def SDG_to_CFG_set_def)
        with valid_edge a 
        have "obs_intra (sourcenode a) HRB_slice SCFG = {sourcenode a}"
          by(fastforce intro!:n_in_obs_intra)
        with m  obs_intra (sourcenode a) HRB_slice SCFG
          nx  obs_intra (sourcenode a) HRB_slice SCFG nx  m
        show False by simp
      qed
    next
      case False
      with m  obs_intra (sourcenode a) HRB_slice SCFG
      have "m postdominates (sourcenode a)" by(rule obs_intra_postdominate)
      with ¬ m postdominates (sourcenode a) show False by simp
    qed
  qed
qed



lemma obs_intra_finite:"valid_node n  finite (obs_intra n HRB_slice SCFG)"
by(fastforce dest:obs_intra_singleton_disj[of _ S])

lemma obs_intra_singleton:"valid_node n  card (obs_intra n HRB_slice SCFG)  1"
by(fastforce dest:obs_intra_singleton_disj[of _ S])


lemma obs_intra_singleton_element:
  "m  obs_intra n HRB_slice SCFG  obs_intra n HRB_slice SCFG = {m}"
apply -
apply(frule in_obs_intra_valid)
apply(drule obs_intra_singleton_disj) apply auto
done


lemma obs_intra_the_element: 
  "m  obs_intra n HRB_slice SCFG  (THE m. m  obs_intra n HRB_slice SCFG) = m"
by(fastforce dest:obs_intra_singleton_element)


lemma obs_singleton_element:
  assumes "ms  obs ns HRB_slice SCFG" and "n  set (tl ns). return_node n"
  shows "obs ns HRB_slice SCFG = {ms}"
proof -
  from ms  obs ns HRB_slice SCFG n  set (tl ns). return_node n
  obtain nsx n nsx' n' where "ns = nsx@n#nsx'" and "ms = n'#nsx'"
    and split:"n'  obs_intra n HRB_slice SCFG"
    "nx  set nsx'. nx'. call_of_return_node nx nx'  nx'  HRB_slice SCFG"
    "xs x xs'. nsx = xs@x#xs'  obs_intra x HRB_slice SCFG  {}
     (x''  set (xs'@[n]). nx. call_of_return_node x'' nx  
                                   nx  HRB_slice SCFG)"
    by(erule obsE)
  from n'  obs_intra n HRB_slice SCFG
  have "obs_intra n HRB_slice SCFG = {n'}"
    by(fastforce intro!:obs_intra_singleton_element)
  { fix xs assume "xs  ms" and "xs  obs ns HRB_slice SCFG"
    from xs  obs ns HRB_slice SCFG n  set (tl ns). return_node n
    obtain zs z zs' z' where "ns = zs@z#zs'" and "xs = z'#zs'"
      and "z'  obs_intra z HRB_slice SCFG"
      and "z'  set zs'. nx'. call_of_return_node z' nx'  nx'  HRB_slice SCFG"
      and "xs x xs'. zs = xs@x#xs'  obs_intra x HRB_slice SCFG  {}
       (x''  set (xs'@[z]). nx. call_of_return_node x'' nx  
                                     nx  HRB_slice SCFG)"
      by(erule obsE)
    with ns = nsx@n#nsx' split
    have "nsx = zs  n = z  nsx' = zs'"
      by -(rule obs_split_det[of _ _ _ _ _ _ "HRB_slice SCFG"],fastforce+)
    with ‹obs_intra n HRB_slice SCFG = {n'} z'  obs_intra z HRB_slice SCFG
    have "z' = n'" by simp
    with xs  ms ms = n'#nsx' xs = z'#zs' nsx = zs  n = z  nsx' = zs'
    have False by simp }
  with ms  obs ns HRB_slice SCFG show ?thesis by fastforce
qed


lemma obs_finite:"n  set (tl ns). return_node n 
   finite (obs ns HRB_slice SCFG)"
by(cases "obs ns HRB_slice SCFG = {}",auto dest:obs_singleton_element[of _ _ S])

lemma obs_singleton:"n  set (tl ns). return_node n 
   card (obs ns HRB_slice SCFG)  1"
by(cases "obs ns HRB_slice SCFG = {}",auto dest:obs_singleton_element[of _ _ S])

lemma obs_the_element: 
  "ms  obs ns HRB_slice SCFG; n  set (tl ns). return_node n 
   (THE ms. ms  obs ns HRB_slice SCFG) = ms"
by(cases "obs ns HRB_slice SCFG = {}",auto dest:obs_singleton_element[of _ _ S])
  

end

end

Theory Distance

section ‹Distance of Paths›

theory Distance imports CFG begin

context CFG begin

inductive distance :: "'node  'node  nat  bool"
where distanceI:
  "n -asι* n'; length as = x; as'. n -as'ι* n'  x  length as'
   distance n n' x"


lemma every_path_distance:
  assumes "n -asι* n'"
  obtains x where "distance n n' x" and "x  length as"
proof(atomize_elim)
  show "x. distance n n' x  x  length as"
  proof(cases "as'. n -as'ι* n'  
                     (asx. n -asxι* n'  length as'  length asx)")
    case True
    then obtain as' 
      where "n -as'ι* n'  (asx. n -asxι* n'  length as'  length asx)" 
      by blast
    hence "n -as'ι* n'" and all:"asx. n -asxι* n'  length as'  length asx"
      by simp_all
    hence "distance n n' (length as')" by(fastforce intro:distanceI)
    from n -asι* n' all have "length as'  length as" by fastforce
    with ‹distance n n' (length as') show ?thesis by blast
  next
    case False
    hence all:"as'. n -as'ι* n'  (asx. n -asxι* n'  length as' > length asx)"
      by fastforce
    have "wf (measure length)" by simp
    from n -asι* n' have "as  {as. n -asι* n'}" by simp
    with ‹wf (measure length) obtain as' where "as'  {as. n -asι* n'}" 
      and notin:"as''. (as'',as')  (measure length)  as''  {as. n -asι* n'}"
      by(erule wfE_min)
    from as'  {as. n -asι* n'} have "n -as'ι* n'" by simp
    with all obtain asx where "n -asxι* n'"
      and "length as' > length asx"
      by blast
    with notin have  "asx  {as. n -asι* n'}" by simp
    hence "¬ n -asxι* n'" by simp
    with n -asxι* n' have False by simp
    thus ?thesis by simp
  qed
qed


lemma distance_det:
  "distance n n' x; distance n n' x'  x = x'"
apply(erule distance.cases)+ apply clarsimp
apply(erule_tac x="asa" in allE) apply(erule_tac x="as" in allE)
by simp


lemma only_one_SOME_dist_edge:
  assumes "valid_edge a" and "intra_kind(kind a)" and "distance (targetnode a) n' x"
  shows "∃!a'. sourcenode a = sourcenode a'  distance (targetnode a') n' x 
               valid_edge a'  intra_kind(kind a') 
               targetnode a' = (SOME nx. a'. sourcenode a = sourcenode a' 
                                              distance (targetnode a') n' x 
                                              valid_edge a'  intra_kind(kind a')  
                                              targetnode a' = nx)"
proof(rule ex_ex1I)
  show "a'. sourcenode a = sourcenode a'  
             distance (targetnode a') n' x  valid_edge a'  intra_kind(kind a') 
             targetnode a' = (SOME nx. a'. sourcenode a = sourcenode a'  
                                            distance (targetnode a') n' x 
                                            valid_edge a'  intra_kind(kind a')  
                                            targetnode a' = nx)"
  proof -
    have "(a'. sourcenode a = sourcenode a'  
                distance (targetnode a') n' x  valid_edge a'  intra_kind(kind a') 
                targetnode a' = (SOME nx. a'. sourcenode a = sourcenode a' 
                                               distance (targetnode a') n' x 
                                               valid_edge a'  intra_kind(kind a')  
                                               targetnode a' = nx)) =
      (nx. a'. sourcenode a = sourcenode a'  distance (targetnode a') n' x  
                 valid_edge a'  intra_kind(kind a')  targetnode a' = nx)"
      apply(unfold some_eq_ex[of "λnx. a'. sourcenode a = sourcenode a'  
        distance (targetnode a') n' x  valid_edge a'  intra_kind(kind a')  
        targetnode a' = nx"])
      by simp
    also have "" 
      using valid_edge a ‹intra_kind(kind a) ‹distance (targetnode a) n' x
      by blast
    finally show ?thesis .
  qed
next
  fix a' ax
  assume "sourcenode a = sourcenode a'  
    distance (targetnode a') n' x  valid_edge a'  intra_kind(kind a')  
    targetnode a' = (SOME nx. a'. sourcenode a = sourcenode a'  
                                   distance (targetnode a') n' x  
                                   valid_edge a'  intra_kind(kind a')  
                                   targetnode a' = nx)"
    and "sourcenode a = sourcenode ax  
    distance (targetnode ax) n' x  valid_edge ax  intra_kind(kind ax)  
    targetnode ax = (SOME nx. a'. sourcenode a = sourcenode a' 
                                   distance (targetnode a') n' x  
                                   valid_edge a'  intra_kind(kind a')  
                                   targetnode a' = nx)"
  thus "a' = ax" by(fastforce intro!:edge_det)
qed


lemma distance_successor_distance:
  assumes "distance n n' x" and "x  0" 
  obtains a where "valid_edge a" and "n = sourcenode a" and "intra_kind(kind a)"
  and "distance (targetnode a) n' (x - 1)"
  and "targetnode a = (SOME nx. a'. sourcenode a = sourcenode a'  
                                     distance (targetnode a') n' (x - 1) 
                                     valid_edge a'  intra_kind(kind a') 
                                     targetnode a' = nx)"
proof(atomize_elim)
  show "a. valid_edge a  n = sourcenode a  intra_kind(kind a) 
    distance (targetnode a) n' (x - 1) 
    targetnode a = (SOME nx. a'. sourcenode a = sourcenode a'  
                                  distance (targetnode a') n' (x - 1) 
                                  valid_edge a'  intra_kind(kind a') 
                                  targetnode a' = nx)"
  proof(rule ccontr)
    assume "¬ (a. valid_edge a  n = sourcenode a  intra_kind(kind a) 
                   distance (targetnode a) n' (x - 1)  
                   targetnode a = (SOME nx. a'. sourcenode a = sourcenode a'  
                                                 distance (targetnode a') n' (x - 1) 
                                                 valid_edge a'  intra_kind(kind a') 
                                                 targetnode a' = nx))"
    hence imp:"a. valid_edge a  n = sourcenode a  intra_kind(kind a) 
                   targetnode a = (SOME nx. a'. sourcenode a = sourcenode a' 
                                                 distance (targetnode a') n' (x - 1) 
                                                 valid_edge a'  intra_kind(kind a') 
                                                 targetnode a' = nx)
                  ¬ distance (targetnode a) n' (x - 1)" by blast
    from ‹distance n n' x obtain as where "n -asι* n'" and "x = length as"
      and all:"as'. n -as'ι* n'  x  length as'"
      by(auto elim:distance.cases)
    from n -asι* n' have "n -as→* n'" and "a  set as. intra_kind(kind a)"
      by(simp_all add:intra_path_def)
    from this x = length as all imp show False
    proof(induct rule:path.induct)
      case (empty_path n)
      from x = length [] x  0 show False by simp
    next
      case (Cons_path n'' as n' a n)
      note imp = a. valid_edge a  n = sourcenode a  intra_kind (kind a) 
                      targetnode a = (SOME nx. a'. sourcenode a = sourcenode a' 
                                                 distance (targetnode a') n' (x - 1) 
                                                 valid_edge a'  intra_kind(kind a') 
                                                 targetnode a' = nx)
                     ¬ distance (targetnode a) n' (x - 1)
      note all = as'. n -as'ι* n'  x  length as'
      from aset (a#as). intra_kind (kind a) 
      have "intra_kind (kind a)" and "aset as. intra_kind (kind a)"
        by simp_all
      from n'' -as→* n' aset as. intra_kind (kind a)
      have "n'' -asι* n'" by(simp add:intra_path_def)
      then obtain y where "distance n'' n' y"
        and "y  length as" by(erule every_path_distance)
      from ‹distance n'' n' y obtain as' where "n'' -as'ι* n'"
        and "y = length as'" by(auto elim:distance.cases)
      hence "n'' -as'→* n'" and "aset as'. intra_kind (kind a)"
        by(simp_all add:intra_path_def)
      show False
      proof(cases "y < length as")
        case True
        from valid_edge a sourcenode a = n targetnode a = n'' n'' -as'→* n'
        have "n -a#as'→* n'" by -(rule path.Cons_path)
        with aset as'. intra_kind (kind a) ‹intra_kind (kind a)
        have "n -a#as'ι* n'" by(simp add:intra_path_def)
        with all have "x  length (a#as')" by blast
        with x = length (a#as) True y = length as' show False by simp
      next
        case False
        with y  length as x = length (a#as) have "y = x - 1" by simp
        from targetnode a = n'' ‹distance n'' n' y
        have "distance (targetnode a) n' y" by simp
        with valid_edge a ‹intra_kind(kind a)
        obtain a' where "sourcenode a = sourcenode a'"
          and "distance (targetnode a') n' y" and "valid_edge a'"
          and "intra_kind(kind a')"
          and "targetnode a' = (SOME nx. a'. sourcenode a = sourcenode a' 
                                              distance (targetnode a') n' y 
                                              valid_edge a'  intra_kind(kind a') 
                                              targetnode a' = nx)"
          by(auto dest:only_one_SOME_dist_edge)
        with imp sourcenode a = n y = x - 1 show False by fastforce
      qed
    qed
  qed
qed

end

end

Theory Slice

section ‹Static backward slice›

theory Slice imports SCDObservable Distance begin

context SDG begin

subsection ‹Preliminary definitions on the parameter nodes for defining
  sliced call and return edges›

fun csppa :: "'node  'node SDG_node set  nat  
  ((('var  'val)  'val option) list)  ((('var  'val)  'val option) list)"
  where "csppa m S x [] = []"
  | "csppa m S x (f#fs) = 
     (if Formal_in(m,x)  S then Map.empty else f)#csppa m S (Suc x) fs"

definition cspp :: "'node  'node SDG_node set  
  ((('var  'val)  'val option) list)  ((('var  'val)  'val option) list)"
  where "cspp m S fs  csppa m S 0 fs"

lemma [simp]: "length (csppa m S x fs) = length fs"
by(induct fs arbitrary:x)(auto)

lemma [simp]: "length (cspp m S fs) = length fs"
by(simp add:cspp_def)

lemma csppa_Formal_in_notin_slice: 
  "x < length fs; Formal_in(m,x + i)  S
   (csppa m S i fs)!x = Map.empty"
by(induct fs arbitrary:i x,auto simp:nth_Cons')

lemma csppa_Formal_in_in_slice: 
  "x < length fs; Formal_in(m,x + i)  S
   (csppa m S i fs)!x = fs!x"
by(induct fs arbitrary:i x,auto simp:nth_Cons')


definition map_merge :: "('var  'val)  ('var  'val)  (nat  bool)  
                         'var list  ('var  'val)"
where "map_merge f g Q xs  (λV. if (i. i < length xs  xs!i = V  Q i) then g V 
                                 else f V)"


definition rspp :: "'node  'node SDG_node set  'var list  
  ('var  'val)  ('var  'val)  ('var  'val)"
where "rspp m S xs f g  map_merge f (Map.empty(ParamDefs m [:=] map g xs))
  (λi. Actual_out(m,i)  S) (ParamDefs m)"


lemma rspp_Actual_out_in_slice:
  assumes "x < length (ParamDefs (targetnode a))" and "valid_edge a"
  and "length (ParamDefs (targetnode a)) = length xs" 
  and "Actual_out (targetnode a,x)  S"
  shows "(rspp (targetnode a) S xs f g) ((ParamDefs (targetnode a))!x) = g(xs!x)"
proof -
  from valid_edge a have "distinct(ParamDefs (targetnode a))"
    by(rule distinct_ParamDefs)
  from x < length (ParamDefs (targetnode a)) 
    ‹length (ParamDefs (targetnode a)) = length xs
    ‹distinct(ParamDefs (targetnode a))
  have "(Map.empty(ParamDefs (targetnode a) [:=] map g xs))
    ((ParamDefs (targetnode a))!x) = (map g xs)!x"
    by(fastforce intro:fun_upds_nth)
  with ‹Actual_out(targetnode a,x)  S x < length (ParamDefs (targetnode a))
    ‹length (ParamDefs (targetnode a)) = length xs show ?thesis
    by(fastforce simp:rspp_def map_merge_def)
qed

lemma rspp_Actual_out_notin_slice:
  assumes "x < length (ParamDefs (targetnode a))" and "valid_edge a"
  and "length (ParamDefs (targetnode a)) = length xs" 
  and "Actual_out((targetnode a),x)  S"
  shows "(rspp (targetnode a) S xs f g) ((ParamDefs (targetnode a))!x) = 
  f((ParamDefs (targetnode a))!x)"
proof -
  from valid_edge a have "distinct(ParamDefs (targetnode a))"
    by(rule distinct_ParamDefs)
  from x < length (ParamDefs (targetnode a)) 
    ‹length (ParamDefs (targetnode a)) = length xs
    ‹distinct(ParamDefs (targetnode a))
  have "(Map.empty(ParamDefs (targetnode a) [:=] map g xs))
    ((ParamDefs (targetnode a))!x) = (map g xs)!x"
    by(fastforce intro:fun_upds_nth)
  with ‹Actual_out((targetnode a),x)  S ‹distinct(ParamDefs (targetnode a)) 
    x < length (ParamDefs (targetnode a))
  show ?thesis by(fastforce simp:rspp_def map_merge_def nth_eq_iff_index_eq)
qed


subsection ‹Defining the sliced edge kinds›

primrec slice_kind_aux :: "'node  'node  'node SDG_node set  
  ('var,'val,'ret,'pname) edge_kind  ('var,'val,'ret,'pname) edge_kind"
where "slice_kind_aux m m' S f = (if m  SCFG then f else id)"
  | "slice_kind_aux m m' S (Q) = (if m  SCFG then (Q) else
  (if obs_intra m SCFG = {} then 
    (let mex = (THE mex. method_exit mex  get_proc m = get_proc mex) in
    (if (x. distance m' mex x  distance m mex (x + 1) 
        (m' = (SOME mx'. a'. m = sourcenode a'  
                              distance (targetnode a') mex x 
                              valid_edge a'  intra_kind(kind a') 
                              targetnode a' = mx'))) 
          then (λcf. True) else (λcf. False)))
     else (let mx = THE mx. mx  obs_intra m SCFG in 
       (if (x. distance m' mx x  distance m mx (x + 1) 
            (m' = (SOME mx'. a'. m = sourcenode a'  
                                  distance (targetnode a') mx x 
                                  valid_edge a'  intra_kind(kind a') 
                                  targetnode a' = mx'))) 
          then (λcf. True) else (λcf. False)))))"
  | "slice_kind_aux m m' S (Q:rpfs) = (if m  SCFG then (Q:rp(cspp m' S fs))
                           else ((λcf. False):rpfs))"
  | "slice_kind_aux m m' S (Qpf) = (if m  SCFG then 
      (let outs = THE outs. ins. (p,ins,outs)  set procs in
         (Qp(λcf cf'. rspp m' S outs cf' cf)))
    else ((λcf. True)p(λcf cf'. cf')))"

definition slice_kind :: "'node SDG_node set  'edge  
  ('var,'val,'ret,'pname) edge_kind"
  where "slice_kind S a  
  slice_kind_aux (sourcenode a) (targetnode a) (HRB_slice S) (kind a)"

definition slice_kinds :: "'node SDG_node set  'edge list  
  ('var,'val,'ret,'pname) edge_kind list"
  where "slice_kinds S as  map (slice_kind S) as"



lemma slice_intra_kind_in_slice:
  "sourcenode a  HRB_slice SCFG; intra_kind (kind a) 
   slice_kind S a = kind a"
by(fastforce simp:intra_kind_def slice_kind_def)


lemma slice_kind_Upd:
  "sourcenode a  HRB_slice SCFG; kind a = f  slice_kind S a = id"
by(simp add:slice_kind_def)


lemma slice_kind_Pred_empty_obs_nearer_SOME:
  assumes "sourcenode a  HRB_slice SCFG" and "kind a = (Q)"
  and "obs_intra (sourcenode a) HRB_slice SCFG = {}" 
  and "method_exit mex" and "get_proc (sourcenode a) = get_proc mex"
  and "distance (targetnode a) mex x" and "distance (sourcenode a) mex (x + 1)"
  and "targetnode a = (SOME n'. a'. sourcenode a = sourcenode a'  
                                     distance (targetnode a') mex x 
                                     valid_edge a'  intra_kind(kind a') 
                                     targetnode a' = n')"
  shows "slice_kind S a = (λs. True)"
proof -
  from ‹method_exit mex get_proc (sourcenode a) = get_proc mex
  have "mex = (THE mex. method_exit mex  get_proc (sourcenode a) = get_proc mex)"
    by(auto intro!:the_equality[THEN sym] intro:method_exit_unique)
  with sourcenode a  HRB_slice SCFG kind a = (Q) 
    ‹obs_intra (sourcenode a) HRB_slice SCFG = {}
  have "slice_kind S a = 
    (if (x. distance (targetnode a) mex x  distance (sourcenode a) mex (x + 1) 
    (targetnode a = (SOME mx'. a'. sourcenode a = sourcenode a'  
    distance (targetnode a') mex x  valid_edge a'  intra_kind(kind a') 
    targetnode a' = mx'))) then (λcf. True) else (λcf. False))"
    by(simp add:slice_kind_def Let_def)
  with ‹distance (targetnode a) mex x ‹distance (sourcenode a) mex (x + 1)
    targetnode a = (SOME n'. a'. sourcenode a = sourcenode a'  
                                     distance (targetnode a') mex x 
                                     valid_edge a'  intra_kind(kind a') 
                                     targetnode a' = n')
  show ?thesis by fastforce
qed


lemma slice_kind_Pred_empty_obs_nearer_not_SOME:
  assumes "sourcenode a  HRB_slice SCFG" and "kind a = (Q)"
  and "obs_intra (sourcenode a) HRB_slice SCFG = {}" 
  and "method_exit mex" and "get_proc (sourcenode a) = get_proc mex"
  and "distance (targetnode a) mex x" and "distance (sourcenode a) mex (x + 1)"
  and "targetnode a  (SOME n'. a'. sourcenode a = sourcenode a'  
                                     distance (targetnode a') mex x 
                                     valid_edge a'  intra_kind(kind a') 
                                     targetnode a' = n')"
  shows "slice_kind S a = (λs. False)"
proof -
  from ‹method_exit mex get_proc (sourcenode a) = get_proc mex
  have "mex = (THE mex. method_exit mex  get_proc (sourcenode a) = get_proc mex)"
    by(auto intro!:the_equality[THEN sym] intro:method_exit_unique)
  with sourcenode a  HRB_slice SCFG kind a = (Q) 
    ‹obs_intra (sourcenode a) HRB_slice SCFG = {}
  have "slice_kind S a = 
    (if (x. distance (targetnode a) mex x  distance (sourcenode a) mex (x + 1) 
    (targetnode a = (SOME mx'. a'. sourcenode a = sourcenode a'  
    distance (targetnode a') mex x  valid_edge a'  intra_kind(kind a') 
    targetnode a' = mx'))) then (λcf. True) else (λcf. False))"
    by(simp add:slice_kind_def Let_def)
  with ‹distance (targetnode a) mex x ‹distance (sourcenode a) mex (x + 1)
    targetnode a  (SOME n'. a'. sourcenode a = sourcenode a'  
                                     distance (targetnode a') mex x 
                                     valid_edge a'  intra_kind(kind a') 
                                     targetnode a' = n')
  show ?thesis by(auto dest:distance_det)
qed


lemma slice_kind_Pred_empty_obs_not_nearer:
  assumes "sourcenode a  HRB_slice SCFG" and "kind a = (Q)"
  and "obs_intra (sourcenode a) HRB_slice SCFG = {}" 
  and "method_exit mex" and "get_proc (sourcenode a) = get_proc mex"
  and dist:"distance (sourcenode a) mex (x + 1)" "¬ distance (targetnode a) mex x"
  shows "slice_kind S a = (λs. False)"
proof -
  from ‹method_exit mex get_proc (sourcenode a) = get_proc mex
  have "mex = (THE mex. method_exit mex  get_proc (sourcenode a) = get_proc mex)"
    by(auto intro!:the_equality[THEN sym] intro:method_exit_unique)
  moreover
  from dist have "¬ (x. distance (targetnode a) mex x  
                            distance (sourcenode a) mex (x + 1))"
    by(fastforce dest:distance_det)
  ultimately show ?thesis using assms by(auto simp:slice_kind_def Let_def)
qed


lemma slice_kind_Pred_obs_nearer_SOME:
  assumes "sourcenode a  HRB_slice SCFG" and "kind a = (Q)" 
  and "m  obs_intra (sourcenode a) HRB_slice SCFG"
  and "distance (targetnode a) m x" "distance (sourcenode a) m (x + 1)"
  and "targetnode a = (SOME n'. a'. sourcenode a = sourcenode a' 
                                     distance (targetnode a') m x 
                                     valid_edge a'  intra_kind(kind a')  
                                     targetnode a' = n')"
  shows "slice_kind S a = (λs. True)"
proof -
  from m  obs_intra (sourcenode a) HRB_slice SCFG
  have "m = (THE m. m  obs_intra (sourcenode a) HRB_slice SCFG)"
    by(rule obs_intra_the_element[THEN sym])
  with assms show ?thesis by(auto simp:slice_kind_def Let_def)
qed


lemma slice_kind_Pred_obs_nearer_not_SOME:
  assumes "sourcenode a  HRB_slice SCFG" and "kind a = (Q)" 
  and "m  obs_intra (sourcenode a) HRB_slice SCFG"
  and "distance (targetnode a) m x" "distance (sourcenode a) m (x + 1)"
  and "targetnode a  (SOME nx'. a'. sourcenode a = sourcenode a'  
                                      distance (targetnode a') m x 
                                      valid_edge a'  intra_kind(kind a')  
                                      targetnode a' = nx')"
  shows "slice_kind S a = (λs. False)"
proof -
  from m  obs_intra (sourcenode a) HRB_slice SCFG
  have "m = (THE m. m  obs_intra (sourcenode a) (HRB_slice SCFG))"
    by(rule obs_intra_the_element[THEN sym])
  with assms show ?thesis by(auto dest:distance_det simp:slice_kind_def Let_def)
qed


lemma slice_kind_Pred_obs_not_nearer:
  assumes "sourcenode a  HRB_slice SCFG" and "kind a = (Q)" 
  and in_obs:"m  obs_intra (sourcenode a) HRB_slice SCFG"
  and dist:"distance (sourcenode a) m (x + 1)" 
           "¬ distance (targetnode a) m x"
  shows "slice_kind S a = (λs. False)"
proof -
  from in_obs have the:"m = (THE m. m  obs_intra (sourcenode a) HRB_slice SCFG)"
    by(rule obs_intra_the_element[THEN sym])
  from dist have "¬ (x. distance (targetnode a) m x  
                            distance (sourcenode a) m (x + 1))"
    by(fastforce dest:distance_det)
  with sourcenode a  HRB_slice SCFG kind a = (Q) in_obs the show ?thesis
    by(auto simp:slice_kind_def Let_def)
qed


lemma kind_Predicate_notin_slice_slice_kind_Predicate:
  assumes "sourcenode a  HRB_slice SCFG" and "valid_edge a" and "kind a = (Q)"
  obtains Q' where "slice_kind S a = (Q')" and "Q' = (λs. False)  Q' = (λs. True)"
proof(atomize_elim)
  show "Q'. slice_kind S a = (Q')  (Q' = (λs. False)  Q' = (λs. True))"
  proof(cases "obs_intra (sourcenode a) HRB_slice SCFG = {}")
    case True
    from valid_edge a have "valid_node (sourcenode a)" by simp
    then obtain as where "sourcenode a -as* (_Exit_)" by(fastforce dest:Exit_path)
    then obtain as' mex where "sourcenode a -as'ι* mex" and "method_exit mex" 
      by -(erule valid_Exit_path_intra_path)
    from sourcenode a -as'ι* mex have "get_proc (sourcenode a) = get_proc mex"
      by(rule intra_path_get_procs)
    show ?thesis
    proof(cases "x. distance (targetnode a) mex x  
        distance (sourcenode a) mex (x + 1)")
      case True
      then obtain x where "distance (targetnode a) mex x" 
        and "distance (sourcenode a) mex (x + 1)" by blast
      show ?thesis
      proof(cases "targetnode a = (SOME n'. a'. sourcenode a = sourcenode a' 
                                                 distance (targetnode a') mex x 
                                                 valid_edge a'  intra_kind(kind a') 
                                                 targetnode a' = n')")
        case True
        with sourcenode a  HRB_slice SCFG kind a = (Q)
          ‹obs_intra (sourcenode a) HRB_slice SCFG = {}
          ‹method_exit mex get_proc (sourcenode a) = get_proc mex
          ‹distance (targetnode a) mex x ‹distance (sourcenode a) mex (x + 1)
        have "slice_kind S a = (λs. True)"
          by(rule slice_kind_Pred_empty_obs_nearer_SOME)
        thus ?thesis by simp
      next
        case False
        with sourcenode a  HRB_slice SCFG kind a = (Q)
          ‹obs_intra (sourcenode a) HRB_slice SCFG = {}
          ‹method_exit mex get_proc (sourcenode a) = get_proc mex
          ‹distance (targetnode a) mex x ‹distance (sourcenode a) mex (x + 1)
        have "slice_kind S a = (λs. False)"
          by(rule slice_kind_Pred_empty_obs_nearer_not_SOME)
        thus ?thesis by simp
      qed
    next
      case False
      from ‹method_exit mex get_proc (sourcenode a) = get_proc mex
      have "mex = (THE mex. method_exit mex  get_proc (sourcenode a) = get_proc mex)"
        by(auto intro!:the_equality[THEN sym] intro:method_exit_unique)
      with sourcenode a  HRB_slice SCFG kind a = (Q)
        ‹obs_intra (sourcenode a) HRB_slice SCFG = {} False
      have "slice_kind S a = (λs. False)"
        by(auto simp:slice_kind_def Let_def)
      thus ?thesis by simp
    qed
  next
    case False
    then obtain m where "m  obs_intra (sourcenode a) HRB_slice SCFG" by blast
    show ?thesis
    proof(cases "x. distance (targetnode a) m x  
        distance (sourcenode a) m (x + 1)")
      case True
      then obtain x where "distance (targetnode a) m x" 
        and "distance (sourcenode a) m (x + 1)" by blast
      show ?thesis
      proof(cases "targetnode a = (SOME n'. a'. sourcenode a = sourcenode a' 
                                                 distance (targetnode a') m x 
                                                 valid_edge a'  intra_kind(kind a') 
                                                 targetnode a' = n')")
        case True
        with sourcenode a  HRB_slice SCFG kind a = (Q)
          m  obs_intra (sourcenode a) HRB_slice SCFG
          ‹distance (targetnode a) m x ‹distance (sourcenode a) m (x + 1)
        have "slice_kind S a = (λs. True)"
          by(rule slice_kind_Pred_obs_nearer_SOME)
        thus ?thesis by simp
      next
        case False
        with sourcenode a  HRB_slice SCFG kind a = (Q)
          m  obs_intra (sourcenode a) HRB_slice SCFG
          ‹distance (targetnode a) m x ‹distance (sourcenode a) m (x + 1)
        have "slice_kind S a = (λs. False)"
          by(rule slice_kind_Pred_obs_nearer_not_SOME)
        thus ?thesis by simp
      qed
    next
      case False
      from m  obs_intra (sourcenode a) HRB_slice SCFG
      have "m = (THE m. m  obs_intra (sourcenode a) HRB_slice SCFG)"
        by(rule obs_intra_the_element[THEN sym])
      with sourcenode a  HRB_slice SCFG kind a = (Q) False
        m  obs_intra (sourcenode a) HRB_slice SCFG
      have "slice_kind S a = (λs. False)"
        by(auto simp:slice_kind_def Let_def)
      thus ?thesis by simp
    qed
  qed
qed


lemma slice_kind_Call:
  "sourcenode a  HRB_slice SCFG; kind a = Q:rpfs 
   slice_kind S a = (λcf. False):rpfs"
by(simp add:slice_kind_def)


lemma slice_kind_Call_in_slice:
  "sourcenode a  HRB_slice SCFG; kind a = Q:rpfs 
   slice_kind S a = Q:rp(cspp (targetnode a) (HRB_slice S) fs)"
by(simp add:slice_kind_def)


lemma slice_kind_Call_in_slice_Formal_in_not:
  assumes "sourcenode a  HRB_slice SCFG" and "kind a = Q:rpfs"
  and "x < length fs. Formal_in(targetnode a,x)  HRB_slice S" 
  shows "slice_kind S a = Q:rpreplicate (length fs) Map.empty"
proof -
  from sourcenode a  HRB_slice SCFG kind a = Q:rpfs
  have "slice_kind S a = Q:rp(cspp (targetnode a) (HRB_slice S) fs)"
    by(simp add:slice_kind_def)
  from x < length fs. Formal_in(targetnode a,x)  HRB_slice S
  have "cspp (targetnode a) (HRB_slice S) fs = replicate (length fs) Map.empty"
    by(fastforce intro:nth_equalityI csppa_Formal_in_notin_slice simp:cspp_def)
  with ‹slice_kind S a = Q:rp(cspp (targetnode a) (HRB_slice S) fs)
  show ?thesis by simp
qed


lemma slice_kind_Call_in_slice_Formal_in_also:
  assumes "sourcenode a  HRB_slice SCFG" and "kind a = Q:rpfs"
  and "x < length fs. Formal_in(targetnode a,x)  HRB_slice S" 
  shows "slice_kind S a = Q:rpfs"
proof -
  from sourcenode a  HRB_slice SCFG kind a = Q:rpfs
  have "slice_kind S a = Q:rp(cspp (targetnode a) (HRB_slice S) fs)"
    by(simp add:slice_kind_def)
  from x < length fs. Formal_in(targetnode a,x)  HRB_slice S
  have "cspp (targetnode a) (HRB_slice S) fs = fs"
    by(fastforce intro:nth_equalityI csppa_Formal_in_in_slice simp:cspp_def)
  with ‹slice_kind S a = Q:rp(cspp (targetnode a) (HRB_slice S) fs)
  show ?thesis by simp
qed


lemma slice_kind_Call_intra_notin_slice:
  assumes "sourcenode a  HRB_slice SCFG" and "valid_edge a" 
  and "intra_kind (kind a)" and "valid_edge a'" and "kind a' = Q:rpfs"
  and "sourcenode a' = sourcenode a"
  shows "slice_kind S a = (λs. True)"
proof -
  from valid_edge a' kind a' = Q:rpfs obtain a'' 
    where "a''  get_return_edges a'"
    by(fastforce dest:get_return_edge_call)
  with valid_edge a' obtain ax where "valid_edge ax" 
    and "sourcenode ax = sourcenode a'" and " targetnode ax = targetnode a''"
    and "kind ax = (λcf. False)"
    by(fastforce dest:call_return_node_edge)
  from valid_edge a' kind a' = Q:rpfs
  have "∃!a''. valid_edge a''  sourcenode a'' = sourcenode a'  
    intra_kind(kind a'')"
    by(rule call_only_one_intra_edge)
  with valid_edge a sourcenode a' = sourcenode a ‹intra_kind (kind a)
  have all:"a''. valid_edge a''  sourcenode a'' = sourcenode a'  
    intra_kind(kind a'')  a'' = a" by fastforce
  with valid_edge ax sourcenode ax = sourcenode a' kind ax = (λcf. False)
  have [simp]:"ax = a" by(fastforce simp:intra_kind_def)
  show ?thesis
  proof(cases "obs_intra (sourcenode a) HRB_slice SCFG = {}")
    case True
    from valid_edge a have "valid_node (sourcenode a)" by simp
    then obtain asx where "sourcenode a -asx* (_Exit_)" by(fastforce dest:Exit_path)
    then obtain as pex where "sourcenode a-asι* pex" and "method_exit pex"
      by -(erule valid_Exit_path_intra_path)
    from sourcenode a-asι* pex have "get_proc (sourcenode a) = get_proc pex"
      by(rule intra_path_get_procs)
    from sourcenode a-asι* pex obtain x where "distance (sourcenode a) pex x"
      and "x  length as" by(erule every_path_distance)
    from ‹method_exit pex have "sourcenode a  pex"
    proof(rule method_exit_cases)
      assume "pex = (_Exit_)"
      show ?thesis
      proof
        assume "sourcenode a = pex"
        with pex = (_Exit_) have "sourcenode a = (_Exit_)" by simp
        with valid_edge a show False by(rule Exit_source)
      qed
    next
      fix ax Qx px fx 
      assume "pex = sourcenode ax" and "valid_edge ax" and "kind ax = Qxpxfx"
      hence "a'. valid_edge a'  sourcenode a' = sourcenode ax  
        (Qx' fx'. kind a' = Qx'pxfx')" by -(rule return_edges_only)
      with valid_edge a ‹intra_kind (kind a) pex = sourcenode ax
      show ?thesis by(fastforce simp:intra_kind_def)
    qed
    have "x  0"
    proof
      assume "x = 0"
      with ‹distance (sourcenode a) pex x have "sourcenode a = pex"
        by(fastforce elim:distance.cases simp:intra_path_def)
      with sourcenode a  pex show False by simp
    qed
    with ‹distance (sourcenode a) pex x obtain ax' where "valid_edge ax'"
      and "sourcenode a = sourcenode ax'" and "intra_kind(kind ax')"
      and "distance (targetnode ax') pex (x - 1)"
      and Some:"targetnode ax' = (SOME nx. a'. sourcenode ax' = sourcenode a'  
                                          distance (targetnode a') pex (x - 1) 
                                          valid_edge a'  intra_kind(kind a') 
                                          targetnode a' = nx)"
      by(erule distance_successor_distance)
    from valid_edge ax' sourcenode a = sourcenode ax' ‹intra_kind(kind ax')
      sourcenode a' = sourcenode a all
    have [simp]:"ax' = a" by fastforce
    from sourcenode a  HRB_slice SCFG kind ax = (λcf. False)
      True ‹method_exit pex get_proc (sourcenode a) = get_proc pex x  0
      ‹distance (targetnode ax') pex (x - 1) ‹distance (sourcenode a) pex x Some
    show ?thesis by(fastforce elim:slice_kind_Pred_empty_obs_nearer_SOME)
  next
    case False
    then obtain m where "m  obs_intra (sourcenode a) HRB_slice SCFG" by fastforce
    then obtain as where "sourcenode a-asι* m" and "m  HRB_slice SCFG"
      by -(erule obs_intraE)
    from sourcenode a-asι* m obtain x where "distance (sourcenode a) m x"
      and "x  length as" by(erule every_path_distance)
    from sourcenode a  HRB_slice SCFG m  HRB_slice SCFG
    have "sourcenode a  m" by fastforce
    have "x  0"
    proof
      assume "x = 0"
      with ‹distance (sourcenode a) m x have "sourcenode a = m"
        by(fastforce elim:distance.cases simp:intra_path_def)
      with sourcenode a  m show False by simp
    qed
    with ‹distance (sourcenode a) m x obtain ax' where "valid_edge ax'"
      and "sourcenode a = sourcenode ax'" and "intra_kind(kind ax')"
      and "distance (targetnode ax') m (x - 1)"
      and Some:"targetnode ax' = (SOME nx. a'. sourcenode ax' = sourcenode a'  
                                          distance (targetnode a') m (x - 1) 
                                          valid_edge a'  intra_kind(kind a') 
                                          targetnode a' = nx)"
      by(erule distance_successor_distance)
    from valid_edge ax' sourcenode a = sourcenode ax' ‹intra_kind(kind ax')
      sourcenode a' = sourcenode a all
    have [simp]:"ax' = a" by fastforce
    from sourcenode a  HRB_slice SCFG kind ax = (λcf. False)
      m  obs_intra (sourcenode a) HRB_slice SCFG x  0
      ‹distance (targetnode ax') m (x - 1) ‹distance (sourcenode a) m x Some
    show ?thesis by(fastforce elim:slice_kind_Pred_obs_nearer_SOME)
  qed
qed


lemma slice_kind_Return:
  "sourcenode a  HRB_slice SCFG; kind a = Qpf
   slice_kind S a = (λcf. True)p(λcf cf'. cf')"
by(simp add:slice_kind_def)


lemma slice_kind_Return_in_slice:
  "sourcenode a  HRB_slice SCFG; valid_edge a; kind a = Qpf; 
   (p,ins,outs)  set procs
   slice_kind S a = Qp(λcf cf'. rspp (targetnode a) (HRB_slice S) outs cf' cf)"
by(simp add:slice_kind_def,unfold formal_out_THE,simp)


lemma length_transfer_kind_slice_kind:
  assumes "valid_edge a" and "length s1 = length s2"
  and "transfer (kind a) s1 = s1'" and "transfer (slice_kind S a) s2 = s2'"
  shows "length s1' = length s2'"
proof(cases "kind a" rule:edge_kind_cases)
  case Intra
  show ?thesis
  proof(cases "sourcenode a  HRB_slice SCFG")
    case True
    with Intra assms show ?thesis
      by(cases s1)(cases s2,auto dest:slice_intra_kind_in_slice simp:intra_kind_def)+
  next
    case False
    with Intra assms show ?thesis
      by(cases s1)(cases s2,auto dest:slice_kind_Upd 
        elim:kind_Predicate_notin_slice_slice_kind_Predicate simp:intra_kind_def)+
  qed
next
  case (Call Q r p fs)
  show ?thesis
  proof(cases "sourcenode a  HRB_slice SCFG")
    case True
    with Call assms show ?thesis
      by(cases s1)(cases s2,auto dest:slice_kind_Call_in_slice)+
  next
    case False
    with Call assms show ?thesis
      by(cases s1)(cases s2,auto dest:slice_kind_Call)+
  qed
next
  case (Return Q p f)
  show ?thesis
  proof(cases "sourcenode a  HRB_slice SCFG")
    case True
    from Return valid_edge a obtain a' Q' r fs 
      where "valid_edge a'" and "kind a' = Q':rpfs"
      by -(drule return_needs_call,auto)
    then obtain ins outs where "(p,ins,outs)  set procs"
      by(fastforce dest!:callee_in_procs)
    with True valid_edge a Return assms show ?thesis
      by(cases s1)(cases s2,auto dest:slice_kind_Return_in_slice split:list.split)+
  next    
    case False
    with Return assms show ?thesis
      by(cases s1)(cases s2,auto dest:slice_kind_Return split:list.split)+
  qed
qed


subsection ‹The sliced graph of a deterministic CFG is still deterministic› 

lemma only_one_SOME_edge:
  assumes "valid_edge a" and "intra_kind(kind a)" and "distance (targetnode a) mex x"
  shows "∃!a'. sourcenode a = sourcenode a'  distance (targetnode a') mex x 
               valid_edge a'  intra_kind(kind a') 
               targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                              distance (targetnode a') mex x 
                                              valid_edge a'  intra_kind(kind a') 
                                              targetnode a' = n')"
proof(rule ex_ex1I)
  show "a'. sourcenode a = sourcenode a'  distance (targetnode a') mex x 
             valid_edge a'  intra_kind(kind a') 
             targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                            distance (targetnode a') mex x 
                                            valid_edge a'  intra_kind(kind a') 
                                            targetnode a' = n')"
  proof -
    have "(a'. sourcenode a = sourcenode a'  distance (targetnode a') mex x 
                valid_edge a'  intra_kind(kind a') 
                targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                               distance (targetnode a') mex x 
                                               valid_edge a'  intra_kind(kind a') 
                                               targetnode a' = n')) =
      (n'. a'. sourcenode a = sourcenode a'  distance (targetnode a') mex x 
                 valid_edge a'  intra_kind(kind a')  targetnode a' = n')"
      apply(unfold some_eq_ex[of "λn'. a'. sourcenode a = sourcenode a'  
                                            distance (targetnode a') mex x 
                                            valid_edge a'  intra_kind(kind a') 
                                            targetnode a' = n'"])
      by simp
    also have "" 
      using valid_edge a ‹intra_kind(kind a) ‹distance (targetnode a) mex x 
      by blast
    finally show ?thesis .
  qed
next
  fix a' ax
  assume "sourcenode a = sourcenode a'  distance (targetnode a') mex x 
    valid_edge a'  intra_kind(kind a') 
    targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                   distance (targetnode a') mex x 
                                   valid_edge a'  intra_kind(kind a') 
                                   targetnode a' = n')"
    and "sourcenode a = sourcenode ax  distance (targetnode ax) mex x 
    valid_edge ax  intra_kind(kind ax) 
    targetnode ax = (SOME n'. a'. sourcenode a = sourcenode a'  
                                   distance (targetnode a') mex x 
                                   valid_edge a'  intra_kind(kind a') 
                                   targetnode a' = n')"
  thus "a' = ax" by(fastforce intro!:edge_det)
qed


lemma slice_kind_only_one_True_edge:
  assumes "sourcenode a = sourcenode a'" and "targetnode a  targetnode a'" 
  and "valid_edge a" and "valid_edge a'" and "intra_kind (kind a)" 
  and "intra_kind (kind a')" and "slice_kind S a = (λs. True)"
  shows "slice_kind S a' = (λs. False)"
proof -
  from assms obtain Q Q' where "kind a = (Q)"
    and "kind a' = (Q')" and det:"s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s)"
    by(auto dest:deterministic)
  show ?thesis
  proof(cases "sourcenode a  HRB_slice SCFG")
    case True
    with ‹slice_kind S a = (λs. True) kind a = (Q) have "Q = (λs. True)"
      by(simp add:slice_kind_def Let_def)
    with det have "Q' = (λs. False)" by(simp add:fun_eq_iff)
    with True kind a' = (Q') sourcenode a = sourcenode a' show ?thesis
      by(simp add:slice_kind_def Let_def)
  next
    case False
    hence "sourcenode a  HRB_slice SCFG" by simp
    thus ?thesis
    proof(cases "obs_intra (sourcenode a) HRB_slice SCFG = {}")
      case True
      with sourcenode a  HRB_slice SCFG ‹slice_kind S a = (λs. True)
        kind a = (Q)
      obtain mex x where mex:"mex = (THE mex. method_exit mex  
        get_proc (sourcenode a) = get_proc mex)"
        and dist:"distance (targetnode a) mex x" "distance (sourcenode a) mex (x + 1)"
        and target:"targetnode a = (SOME n'. a'. sourcenode a = sourcenode a'  
                                                 distance (targetnode a') mex x 
                                                 valid_edge a'  intra_kind(kind a') 
                                                 targetnode a' = n')"
        by(auto simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
      from valid_edge a ‹intra_kind (kind a) ‹distance (targetnode a) mex x
      have ex1:"∃!a'. sourcenode a = sourcenode a'  distance (targetnode a') mex x  
        valid_edge a'  intra_kind(kind a') 
        targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                       distance (targetnode a') mex x 
                                       valid_edge a'  intra_kind(kind a') 
                                       targetnode a' = n')"
        by(rule only_one_SOME_edge)
      have "targetnode a'  (SOME n'. a'. sourcenode a = sourcenode a'  
                                           distance (targetnode a') mex x 
                                           valid_edge a'  intra_kind(kind a') 
                                           targetnode a' = n')"
      proof(rule ccontr)
        assume "¬ targetnode a'  (SOME n'. a'. sourcenode a = sourcenode a'  
                                                 distance (targetnode a') mex x 
                                                 valid_edge a'  intra_kind(kind a') 
                                                 targetnode a' = n')"
        hence "targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a'  
                                              distance (targetnode a') mex x 
                                              valid_edge a'  intra_kind(kind a') 
                                              targetnode a' = n')"
          by simp
        with ex1 target sourcenode a = sourcenode a' valid_edge a valid_edge a'
          ‹intra_kind(kind a) ‹intra_kind(kind a') ‹distance (targetnode a) mex x
        have "a = a'" by fastforce
        with targetnode a  targetnode a' show False by simp
      qed
      with sourcenode a  HRB_slice SCFG True kind a' = (Q')
        sourcenode a = sourcenode a' mex dist
      show ?thesis by(auto dest:distance_det 
        simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
    next
      case False
      hence "obs_intra (sourcenode a) HRB_slice SCFG  {}" .
      then obtain m where "m  obs_intra (sourcenode a) HRB_slice SCFG" by auto
      hence "m = (THE m. m  obs_intra (sourcenode a) HRB_slice SCFG)"
        by(auto dest:obs_intra_the_element)
      with sourcenode a  HRB_slice SCFG 
        ‹obs_intra (sourcenode a) HRB_slice SCFG  {} 
        ‹slice_kind S a = (λs. True) kind a = (Q)
      obtain x x' where "distance (targetnode a) m x" 
        "distance (sourcenode a) m (x + 1)"
        and target:"targetnode a = (SOME n'. a'. sourcenode a = sourcenode a' 
                                                 distance (targetnode a') m x 
                                                 valid_edge a'  intra_kind(kind a') 
                                                 targetnode a' = n')"
        by(auto simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
      show ?thesis
      proof(cases "distance (targetnode a') m x")
        case False
        with sourcenode a  HRB_slice SCFG kind a' = (Q')
          m  obs_intra (sourcenode a) HRB_slice SCFG
          ‹distance (targetnode a) m x ‹distance (sourcenode a) m (x + 1)
          sourcenode a = sourcenode a' show ?thesis
          by(fastforce intro:slice_kind_Pred_obs_not_nearer)
      next
        case True
        from valid_edge a ‹intra_kind(kind a) ‹distance (targetnode a) m x
          ‹distance (sourcenode a) m (x + 1)
        have ex1:"∃!a'. sourcenode a = sourcenode a'  
               distance (targetnode a') m x  valid_edge a'  intra_kind(kind a')  
               targetnode a' = (SOME nx. a'. sourcenode a = sourcenode a' 
                                              distance (targetnode a') m x 
                                              valid_edge a'  intra_kind(kind a')  
                                              targetnode a' = nx)"
          by -(rule only_one_SOME_dist_edge)
        have "targetnode a'  (SOME n'. a'. sourcenode a = sourcenode a'  
                                               distance (targetnode a') m x 
                                               valid_edge a'  intra_kind(kind a')  
                                               targetnode a' = n')"
        proof(rule ccontr)
          assume "¬ targetnode a'  (SOME n'. a'. sourcenode a = sourcenode a'  
                                                 distance (targetnode a') m x 
                                                 valid_edge a'  intra_kind(kind a') 
                                                 targetnode a' = n')"
          hence "targetnode a' = (SOME n'. a'. sourcenode a = sourcenode a' 
                                                distance (targetnode a') m x 
                                                valid_edge a'  intra_kind(kind a') 
                                                targetnode a' = n')"
            by simp
          with ex1 target sourcenode a = sourcenode a' 
            valid_edge a valid_edge a' ‹intra_kind(kind a) ‹intra_kind(kind a')
            ‹distance (targetnode a) m x ‹distance (sourcenode a) m (x + 1)
          have "a = a'" by auto
          with targetnode a  targetnode a' show False by simp
        qed
        with sourcenode a  HRB_slice SCFG 
          kind a' = (Q') m  obs_intra (sourcenode a) HRB_slice SCFG
          ‹distance (targetnode a) m x ‹distance (sourcenode a) m (x + 1)
          True sourcenode a = sourcenode a' show ?thesis
          by(fastforce intro:slice_kind_Pred_obs_nearer_not_SOME)
      qed
    qed
  qed
qed


lemma slice_deterministic:
  assumes "valid_edge a" and "valid_edge a'"
  and "intra_kind (kind a)" and "intra_kind (kind a')"
  and "sourcenode a = sourcenode a'" and "targetnode a  targetnode a'"
  obtains Q Q' where "slice_kind S a = (Q)" and "slice_kind S a' = (Q')"
  and "s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s)"
proof(atomize_elim)
  from assms obtain Q Q' 
    where "kind a = (Q)" and "kind a' = (Q')" 
    and det:"s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s)"
    by(auto dest:deterministic)
  show "Q Q'. slice_kind S a = (Q)  slice_kind S a' = (Q')  
                (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))"
  proof(cases "sourcenode a  HRB_slice SCFG")
    case True
    with kind a = (Q) have "slice_kind S a = (Q)"
      by(simp add:slice_kind_def Let_def)
    from True kind a' = (Q') sourcenode a = sourcenode a'
    have "slice_kind S a' = (Q')"
      by(simp add:slice_kind_def Let_def)
    with ‹slice_kind S a = (Q) det show ?thesis by blast
  next
    case False
    with kind a = (Q) 
    have "slice_kind S a = (λs. True)  slice_kind S a = (λs. False)"
      by(simp add:slice_kind_def Let_def)
    thus ?thesis
    proof
      assume true:"slice_kind S a = (λs. True)"
      with sourcenode a = sourcenode a' targetnode a  targetnode a'
        valid_edge a valid_edge a' ‹intra_kind (kind a) ‹intra_kind (kind a')
      have "slice_kind S a' = (λs. False)"
        by(rule slice_kind_only_one_True_edge)
      with true show ?thesis by simp
    next
      assume false:"slice_kind S a = (λs. False)"
      from False kind a' = (Q') sourcenode a = sourcenode a'
      have "slice_kind S a' = (λs. True)  slice_kind S a' = (λs. False)"
        by(simp add:slice_kind_def Let_def)
      with false show ?thesis by auto
    qed
  qed
qed

end

end

Theory WeakSimulation

section ‹The weak simulation›

theory WeakSimulation imports Slice begin

context SDG begin

lemma call_node_notin_slice_return_node_neither:
  assumes "call_of_return_node n n'" and "n'  HRB_slice SCFG"
  shows "n  HRB_slice SCFG"
proof -
  from ‹call_of_return_node n n' obtain a a' where "return_node n"
    and "valid_edge a" and "n' = sourcenode a"
    and "valid_edge a'" and "a'  get_return_edges a" 
    and "n = targetnode a'" by(fastforce simp:call_of_return_node_def)
  from valid_edge a a'  get_return_edges a obtain Q p r fs 
    where "kind a = Q:rpfs" by(fastforce dest!:only_call_get_return_edges)
  with valid_edge a a'  get_return_edges a obtain Q' f' where "kind a' = Q'pf'"
    by(fastforce dest!:call_return_edges)
  from valid_edge a kind a = Q:rpfs a'  get_return_edges a
  have "CFG_node (sourcenode a) s-psum CFG_node (targetnode a')"
    by(fastforce intro:sum_SDG_call_summary_edge)
  show ?thesis
  proof
    assume "n  HRB_slice SCFG"
    with n = targetnode a' have "CFG_node (targetnode a')  HRB_slice S"
      by(simp add:SDG_to_CFG_set_def)
    hence "CFG_node (sourcenode a)  HRB_slice S"
    proof(induct "CFG_node (targetnode a')" rule:HRB_slice_cases)
      case (phase1 nx)
      with ‹CFG_node (sourcenode a) s-psum CFG_node (targetnode a')
      show ?case by(fastforce intro:combine_SDG_slices.combSlice_refl sum_slice1 
                              simp:HRB_slice_def)
    next
      case (phase2 nx n' n'' p')
      from ‹CFG_node (targetnode a')  sum_SDG_slice2 n' 
        ‹CFG_node (sourcenode a) s-psum CFG_node (targetnode a') valid_edge a
      have "CFG_node (sourcenode a)  sum_SDG_slice2 n'"
        by(fastforce intro:sum_slice2)
      with n'  sum_SDG_slice1 nx n'' s-p'ret CFG_node (parent_node n') nx  S
      show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
                              simp:HRB_slice_def)
    qed
    with n'  HRB_slice SCFG n' = sourcenode a show False 
      by(simp add:SDG_to_CFG_set_def HRB_slice_def)
  qed
qed


lemma edge_obs_intra_slice_eq:
assumes "valid_edge a" and "intra_kind (kind a)" and "sourcenode a  HRB_slice SCFG"
  shows "obs_intra (targetnode a) HRB_slice SCFG = 
         obs_intra (sourcenode a) HRB_slice SCFG"
proof -
  from assms have "obs_intra (targetnode a) HRB_slice SCFG 
                   obs_intra (sourcenode a) HRB_slice SCFG"
    by(rule edge_obs_intra_subset)
  from valid_edge a have "valid_node (sourcenode a)" by simp
  { fix x assume "x  obs_intra (sourcenode a) HRB_slice SCFG"
    and "obs_intra (targetnode a) HRB_slice SCFG = {}"
    have "as. targetnode a -asι* x"
    proof(cases "method_exit x")
      case True
      from valid_edge a have "valid_node (targetnode a)" by simp
      then obtain asx where "targetnode a -asx* (_Exit_)" 
        by(fastforce dest:Exit_path)
      then obtain as pex where "targetnode a -asι* pex" and "method_exit pex"
        by -(erule valid_Exit_path_intra_path)
      hence "get_proc pex = get_proc (targetnode a)"
        by -(rule intra_path_get_procs[THEN sym])
      also from valid_edge a ‹intra_kind (kind a) 
      have " = get_proc (sourcenode a)"
        by -(rule get_proc_intra[THEN sym])
      also from x  obs_intra (sourcenode a) HRB_slice SCFG True
      have " = get_proc x"
        by(fastforce elim:obs_intraE intro:intra_path_get_procs)
      finally have "pex = x" using ‹method_exit pex True
        by -(rule method_exit_unique)
      with targetnode a -asι* pex show ?thesis by fastforce
    next
      case False
      with x  obs_intra (sourcenode a) HRB_slice SCFG
      have "x postdominates (sourcenode a)" by(rule obs_intra_postdominate)
      with valid_edge a ‹intra_kind (kind a) sourcenode a  HRB_slice SCFG
        x  obs_intra (sourcenode a) HRB_slice SCFG
      have "x postdominates (targetnode a)"
        by(fastforce elim:postdominate_inner_path_targetnode path_edge obs_intraE 
                    simp:intra_path_def sourcenodes_def)
      thus ?thesis by(fastforce elim:postdominate_implies_inner_path)
    qed
    then obtain as where "targetnode a -asι* x" by blast
    from x  obs_intra (sourcenode a) HRB_slice SCFG
    have "x  HRB_slice SCFG" by -(erule obs_intraE)
    have "x'  HRB_slice SCFG. as'. targetnode a -as'ι* x'  
      (a'  set (sourcenodes as'). a'  HRB_slice SCFG)"
    proof(cases "a'  set (sourcenodes as). a'  HRB_slice SCFG")
      case True
      then obtain zs z zs' where "sourcenodes as = zs@z#zs'"
        and "z  HRB_slice SCFG" and "z'  set zs. z'  HRB_slice SCFG"
        by(erule split_list_first_propE)
      then obtain ys y ys'
        where "sourcenodes ys = zs" and "as = ys@y#ys'"
        and "sourcenode y = z"
        by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
      from targetnode a -asι* x as = ys@y#ys'
      have "targetnode a -ys@y#ys'→* x" and "y'  set ys. intra_kind (kind y')"
        by(simp_all add:intra_path_def)
      from targetnode a -ys@y#ys'→* x have "targetnode a -ys→* sourcenode y"
        by(rule path_split)
      with y'  set ys. intra_kind (kind y') sourcenode y = z
        z'  set zs. z'  HRB_slice SCFG z  HRB_slice SCFG
        ‹sourcenodes ys = zs
      show ?thesis by(fastforce simp:intra_path_def)
    next
      case False
      with targetnode a -asι* x x  HRB_slice SCFG
      show ?thesis by fastforce
    qed
    hence "y. y  obs_intra (targetnode a) HRB_slice SCFG"
      by(fastforce intro:obs_intra_elem)
    with ‹obs_intra (targetnode a) HRB_slice SCFG = {} 
    have False by simp }
  with ‹obs_intra (targetnode a) HRB_slice SCFG 
        obs_intra (sourcenode a) HRB_slice SCFG ‹valid_node (sourcenode a)
  show ?thesis by(cases "obs_intra (targetnode a) HRB_slice SCFG = {}") 
                 (auto dest!:obs_intra_singleton_disj)
qed


lemma intra_edge_obs_slice:
  assumes "ms  []" and "ms''  obs ms' HRB_slice SCFG" and "valid_edge a" 
  and "intra_kind (kind a)" 
  and disj:"(m  set (tl ms). m'. call_of_return_node m m'  
                               m'  HRB_slice SCFG)  hd ms  HRB_slice SCFG"
  and "hd ms = sourcenode a" and "ms' = targetnode a#tl ms" 
  and "n  set (tl ms'). return_node n"
  shows "ms''  obs ms HRB_slice SCFG"
proof -
  from ms''  obs ms' HRB_slice SCFG n  set (tl ms'). return_node n
  obtain msx m msx' mx m' where "ms' = msx@m#msx'" and "ms'' = mx#msx'"
    and "mx  obs_intra m HRB_slice SCFG"
    and "nx  set msx'. nx'. call_of_return_node nx nx'  nx'  HRB_slice SCFG"
    and imp:"xs x xs'. msx = xs@x#xs'  obs_intra x HRB_slice SCFG  {}
     (x''  set (xs'@[m]). mx. call_of_return_node x'' mx  
                                   mx  HRB_slice SCFG)"
    by(erule obsE)
  show ?thesis
  proof(cases msx)
    case Nil
    with nx  set msx'. nx'. call_of_return_node nx nx'  nx'  HRB_slice SCFG
      disj ms' = msx@m#msx' ‹hd ms = sourcenode a ms' = targetnode a#tl ms
    have "sourcenode a  HRB_slice SCFG" by(cases ms) auto
    from ms' = msx@m#msx' ms' = targetnode a#tl ms Nil 
    have "m = targetnode a" by simp
    with valid_edge a ‹intra_kind (kind a) sourcenode a  HRB_slice SCFG
      mx  obs_intra m HRB_slice SCFG
    have "mx  obs_intra (sourcenode a) HRB_slice SCFG"
      by(fastforce dest:edge_obs_intra_subset)
    from ms' = msx@m#msx' Nil ms' = targetnode a # tl ms 
      ‹hd ms = sourcenode a ms  []
    have "ms = []@sourcenode a#msx'" by(cases ms) auto
    with ms'' = mx#msx' mx  obs_intra (sourcenode a) HRB_slice SCFG  
      nx  set msx'. nx'. call_of_return_node nx nx'  nx'  HRB_slice SCFG Nil
    show ?thesis by(fastforce intro!:obsI)
  next
    case (Cons x xs)
    with ms' = msx@m#msx' ms' = targetnode a # tl ms
    have "msx = targetnode a#xs" by simp
    from Cons ms' = msx@m#msx' ms' = targetnode a # tl ms ‹hd ms = sourcenode a
    have "ms = (sourcenode a#xs)@m#msx'" by(cases ms) auto
    from disj ms = (sourcenode a#xs)@m#msx' 
      nx  set msx'. nx'. call_of_return_node nx nx'  nx'  HRB_slice SCFG
    have disj2:"(m  set (xs@[m]). m'. call_of_return_node m m'  
                            m'  HRB_slice SCFG)  hd ms  HRB_slice SCFG"
      by fastforce
    hence "zs z zs'. sourcenode a#xs = zs@z#zs'  obs_intra z HRB_slice SCFG  {}
       (z''  set (zs'@[m]). mx. call_of_return_node z'' mx  
                                   mx  HRB_slice SCFG)"
    proof(cases "hd ms  HRB_slice SCFG")
      case True
      with ‹hd ms = sourcenode a have "sourcenode a  HRB_slice SCFG" by simp
      with valid_edge a ‹intra_kind (kind a)
      have "obs_intra (targetnode a) HRB_slice SCFG = 
        obs_intra (sourcenode a) HRB_slice SCFG"
        by(rule edge_obs_intra_slice_eq)
      with imp msx = targetnode a#xs show ?thesis
        by auto(case_tac zs,fastforce,erule_tac x="targetnode a#list" in allE,fastforce)
    next
      case False
      with ‹hd ms = sourcenode a valid_edge a 
      have "obs_intra (sourcenode a) HRB_slice SCFG = {sourcenode a}"
        by(fastforce intro!:n_in_obs_intra)
      from False disj2 
      have "m  set (xs@[m]). m'. call_of_return_node m m'  m'  HRB_slice SCFG"
        by simp
      with imp ‹obs_intra (sourcenode a) HRB_slice SCFG = {sourcenode a}
        msx = targetnode a#xs show ?thesis
        by auto(case_tac zs,fastforce,erule_tac x="targetnode a#list" in allE,fastforce)
    qed
    with ms' = msx@m#msx' ms' = targetnode a # tl ms ‹hd ms = sourcenode a
      ms'' = mx#msx' mx  obs_intra m HRB_slice SCFG 
      nx  set msx'. nx'. call_of_return_node nx nx'  nx'  HRB_slice SCFG
      ms = (sourcenode a#xs)@m#msx'
    show ?thesis by(simp del:obs.simps)(rule obsI,auto)
  qed
qed



subsection ‹Silent moves›

inductive silent_move :: 
  "'node SDG_node set  ('edge  ('var,'val,'ret,'pname) edge_kind)  'node list  
  (('var  'val) × 'ret) list  'edge  'node list  (('var  'val) × 'ret) list  bool"
("_,_  '(_,_') -_τ '(_,_')" [51,50,0,0,50,0,0] 51) 

where silent_move_intra:
  "pred (f a) s; transfer (f a) s = s'; valid_edge a; intra_kind(kind a);
    (m  set (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG) 
    hd ms  HRB_slice SCFG; m  set (tl ms). return_node m;
    length s' = length s; length ms = length s;
    hd ms = sourcenode a; ms' = (targetnode a)#tl ms  
   S,f  (ms,s) -aτ (ms',s')"

  | silent_move_call:
  "pred (f a) s; transfer (f a) s = s'; valid_edge a; kind a = Q:rpfs; 
    valid_edge a'; a'  get_return_edges a;
    (m  set (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG) 
    hd ms  HRB_slice SCFG; m  set (tl ms). return_node m;
    length ms = length s; length s' = Suc(length s); 
    hd ms = sourcenode a; ms' = (targetnode a)#(targetnode a')#tl ms  
   S,f  (ms,s) -aτ (ms',s')"

  | silent_move_return:
  "pred (f a) s; transfer (f a) s = s'; valid_edge a; kind a = Qpf'; 
    m  set (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG;
    m  set (tl ms). return_node m; length ms = length s; length s = Suc(length s');
    s'  []; hd ms = sourcenode a; hd(tl ms) = targetnode a; ms' = tl ms  
   S,f  (ms,s) -aτ (ms',s')"


lemma silent_move_valid_nodes:
  "S,f  (ms,s) -aτ (ms',s'); m  set ms'. valid_node m
   m  set ms. valid_node m"
by(induct rule:silent_move.induct)(case_tac ms,auto)+


lemma silent_move_return_node:
  "S,f  (ms,s) -aτ (ms',s')  m  set (tl ms'). return_node m"
proof(induct rule:silent_move.induct)
  case (silent_move_intra f a s s' ms nc ms')
  thus ?case by simp
next
  case (silent_move_call f a s s' Q r p fs a' ms nc ms')
  from valid_edge a' valid_edge a a'  get_return_edges a
  have "return_node (targetnode a')" by(fastforce simp:return_node_def)
  with mset (tl ms). return_node m ms' = targetnode a # targetnode a' # tl ms
  show ?case by simp
next
  case (silent_move_return f a s s' Q p f' ms nc ms')
  thus ?case by(cases "tl ms") auto
qed


lemma silent_move_equal_length:
  assumes "S,f  (ms,s) -aτ (ms',s')" 
  shows "length ms = length s" and "length ms' = length s'"
proof -
  from S,f  (ms,s) -aτ (ms',s')
  have "length ms = length s  length ms' = length s'"
  proof(induct rule:silent_move.induct)
    case (silent_move_intra f a s s' ms nc ms')
    from ‹pred (f a) s obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
    from ‹length ms = length s ms' = targetnode a # tl ms
      ‹length s' = length s show ?case by simp
  next
    case (silent_move_call f a s s' Q r p fs a' ms nc ms')
    from ‹pred (f a) s obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
    from ‹length ms = length s ‹length s' = Suc (length s) 
      ms' = targetnode a # targetnode a' # tl ms show ?case by simp
  next
    case (silent_move_return f a s s' Q p f' ms nc ms')
    from ‹length ms = length s ‹length s = Suc (length s') ms' = tl ms s'  []
    show ?case by simp
  qed
  thus "length ms = length s" and "length ms' = length s'" by simp_all
qed


lemma silent_move_obs_slice:
  "S,kind  (ms,s) -aτ (ms',s'); msx  obs ms' HRB_slice SCFG; 
    n  set (tl ms'). return_node n
   msx  obs ms HRB_slice SCFG"
proof(induct S f"kind" ms s a ms' s' rule:silent_move.induct)
  case (silent_move_intra a s s' ms nc ms')
  from ‹pred (kind a) s ‹length ms = length s have "ms  []"
    by(cases s) auto
  with silent_move_intra show ?case by -(rule intra_edge_obs_slice)
next
  case (silent_move_call a s s' Q r p fs a' ms S ms')
  note disj = (mset (tl ms). m'. call_of_return_node m m'  
    m'  HRB_slice SCFG)  hd ms  HRB_slice SCFG
  from valid_edge a' valid_edge a a'  get_return_edges a
  have "return_node (targetnode a')" by(fastforce simp:return_node_def)
  with valid_edge a a'  get_return_edges a valid_edge a'
  have "call_of_return_node (targetnode a') (sourcenode a)"
    by(simp add:call_of_return_node_def) blast
  from ‹pred (kind a) s ‹length ms = length s
  have "ms  []" by(cases s) auto
  from disj
  show ?case
  proof
    assume "hd ms  HRB_slice SCFG"
    with ‹hd ms = sourcenode a have "sourcenode a  HRB_slice SCFG" by simp
    with ‹call_of_return_node (targetnode a') (sourcenode a)
      ms' = targetnode a # targetnode a' # tl ms
    have "n'  set (tl ms'). nx. call_of_return_node n' nx  nx  HRB_slice SCFG"
      by fastforce
    with msx  obs ms' HRB_slice SCFG ms' = targetnode a # targetnode a' # tl ms
    have "msx  obs (targetnode a' # tl ms) HRB_slice SCFG" by simp
    from valid_edge a a'  get_return_edges a
    obtain a'' where "valid_edge a''" and [simp]:"sourcenode a'' = sourcenode a"
      and [simp]:"targetnode a'' = targetnode a'" and "intra_kind(kind a'')"
      by -(drule call_return_node_edge,auto simp:intra_kind_def)
    from mset (tl ms'). return_node m ms' = targetnode a # targetnode a' # tl ms
    have "mset (tl ms). return_node m" by simp
    with ms  [] msx  obs (targetnode a'#tl ms) HRB_slice SCFG
      valid_edge a'' ‹intra_kind(kind a'') disj
      ‹hd ms = sourcenode a
    show ?case by -(rule intra_edge_obs_slice,fastforce+)
  next
    assume "mset (tl ms).
      m'. call_of_return_node m m'  m'  HRB_slice SCFG"
    with ms  [] msx  obs ms' HRB_slice SCFG
      ms' = targetnode a # targetnode a' # tl ms
    show ?thesis by(cases ms) auto
  qed
next
  case (silent_move_return a s s' Q p f' ms S ms')
  from ‹length ms = length s ‹length s = Suc (length s') s'  []
  have "ms  []" and "tl ms  []" by(auto simp:length_Suc_conv)
  from mset (tl ms).
    m'. call_of_return_node m m'  m'  HRB_slice SCFG
    ‹tl ms  [] ‹hd (tl ms) = targetnode a
  have "(m'. call_of_return_node (targetnode a) m'  m'  HRB_slice SCFG) 
    (mset (tl (tl ms)). m'. call_of_return_node m m'  m'  HRB_slice SCFG)"
    by(cases "tl ms") auto
  hence "obs ms HRB_slice SCFG = obs (tl ms) HRB_slice SCFG"
  proof
    assume "m'. call_of_return_node (targetnode a) m'  m'  HRB_slice SCFG"
    from ‹tl ms  [] have "hd (tl ms)  set (tl ms)" by simp
    with ‹hd (tl ms) = targetnode a have "targetnode a  set (tl ms)" by simp
    with ms  [] 
      m'. call_of_return_node (targetnode a) m'  m'  HRB_slice SCFG
    have "mset (tl ms). m'. call_of_return_node m m'  
      m'  HRB_slice SCFG" by(cases ms) auto
    with ms  [] show ?thesis by(cases ms) auto
  next
    assume "mset (tl (tl ms)). m'. call_of_return_node m m'  
      m'  HRB_slice SCFG"
    with ms  [] ‹tl ms  [] show ?thesis
      by(cases ms,auto simp:Let_def)(case_tac list,auto)+
  qed
  with ms' = tl ms msx  obs ms' HRB_slice SCFG show ?case by simp
qed



lemma silent_move_empty_obs_slice:
  assumes "S,f  (ms,s) -aτ (ms',s')" and "obs ms' HRB_slice SCFG = {}"
  shows "obs ms HRB_slice SCFG = {}"
proof(rule ccontr)
  assume "obs ms HRB_slice SCFG  {}"
  then obtain xs where "xs  obs ms HRB_slice SCFG" by fastforce
  from S,f  (ms,s) -aτ (ms',s')
  have "m  set (tl ms). return_node m"
    by(fastforce elim!:silent_move.cases simp:call_of_return_node_def)
  with xs  obs ms HRB_slice SCFG
  obtain msx m msx' m' where assms:"ms = msx@m#msx'" "xs = m'#msx'"
    "m'  obs_intra m HRB_slice SCFG" 
    "mx  set msx'. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG"
    "xs x xs'. msx = xs@x#xs'  obs_intra x HRB_slice SCFG  {}
     (x''  set (xs'@[m]). mx. call_of_return_node x'' mx  
                              mx  HRB_slice SCFG)"
    by(erule obsE)
  from S,f  (ms,s) -aτ (ms',s') ‹obs ms' HRB_slice SCFG = {} assms
  show False
  proof(induct rule:silent_move.induct)
    case (silent_move_intra f a s s' ms S ms')
    note disj = (mset (tl ms). m'. call_of_return_node m m'  
      m'  HRB_slice SCFG)  hd ms  HRB_slice SCFG
    note msx = xs x xs'. msx = xs@x#xs'  obs_intra x HRB_slice SCFG  {}  
      (x''set (xs' @ [m]). mx. call_of_return_node x'' mx  mx  HRB_slice SCFG)
    note msx' = mxset msx'. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG
    show False
    proof(cases msx)
      case Nil
      with ms = msx @ m # msx' ‹hd ms = sourcenode a have [simp]:"m = sourcenode a"
        and "tl ms = msx'" by simp_all
      from Nil ms' = targetnode a # tl ms ms = msx @ m # msx'
      have "ms' = msx @ targetnode a # msx'" by simp
      from msx' disj ‹tl ms = msx' ‹hd ms = sourcenode a
      have "sourcenode a  HRB_slice SCFG" by fastforce
      with valid_edge a ‹intra_kind (kind a)
      have "obs_intra (targetnode a) HRB_slice SCFG =
        obs_intra (sourcenode a) HRB_slice SCFG" by(rule edge_obs_intra_slice_eq)
      with m'  obs_intra m HRB_slice SCFG
      have "m'  obs_intra (targetnode a) HRB_slice SCFG" by simp
      from msx Nil have "xs x xs'. msx = xs@x#xs'   
        obs_intra x HRB_slice SCFG  {}  
        (x''set (xs' @ [targetnode a]). mx. call_of_return_node x'' mx  
        mx  HRB_slice SCFG)" by simp
      with m'  obs_intra (targetnode a) HRB_slice SCFG msx' 
        ms' = msx @ targetnode a # msx'
      have "m'#msx'  obs ms' HRB_slice SCFG" by(rule obsI)
      with ‹obs ms' HRB_slice SCFG = {} show False by simp
    next
      case (Cons y ys)
      with ms = msx @ m # msx' ms' = targetnode a # tl ms ‹hd ms = sourcenode a
      have "ms' = targetnode a # ys @ m # msx'" and "y = sourcenode a" 
        and "tl ms = ys @ m # msx'" by simp_all
      { fix x assume "x  obs_intra (targetnode a) HRB_slice SCFG"
        have "obs_intra (sourcenode a) HRB_slice SCFG  {}"
        proof(cases "sourcenode a  HRB_slice SCFG")
          case True
          from valid_edge a have "valid_node (sourcenode a)" by simp
          from this True 
          have "obs_intra (sourcenode a) HRB_slice SCFG = {sourcenode a}"
            by(rule n_in_obs_intra)
          thus ?thesis by simp
        next
          case False
          from valid_edge a ‹intra_kind (kind a) False
          have "obs_intra (targetnode a) HRB_slice SCFG = 
            obs_intra (sourcenode a) HRB_slice SCFG"
            by(rule edge_obs_intra_slice_eq)
          with x  obs_intra (targetnode a) HRB_slice SCFG show ?thesis
            by fastforce
        qed }
      with msx Cons y = sourcenode a 
      have "xs x xs'. targetnode a # ys = xs@x#xs'  
        obs_intra x HRB_slice SCFG  {}  (x''set (xs' @ [m]). 
        mx. call_of_return_node x'' mx  mx  HRB_slice SCFG)"
        apply clarsimp apply(case_tac xs) apply auto
        apply(erule_tac x="[]" in allE) apply clarsimp
        apply(erule_tac x="sourcenode a # list" in allE) apply auto
        done
      with m'  obs_intra m HRB_slice SCFG msx' 
        ms' = targetnode a # ys @ m # msx'
      have "m'#msx'  obs ms' HRB_slice SCFG" by -(rule obsI,auto)
      with ‹obs ms' HRB_slice SCFG = {} show False by simp
    qed
  next
    case (silent_move_call f a s s' Q r p fs a' ms S ms')
    note disj = (mset (tl ms). m'. call_of_return_node m m'  
      m'  HRB_slice SCFG)  hd ms  HRB_slice SCFG
    note msx = xs x xs'. msx = xs@x#xs'  obs_intra x HRB_slice SCFG  {}  
      (x''set (xs' @ [m]). mx. call_of_return_node x'' mx  mx  HRB_slice SCFG)
    note msx' = mxset msx'. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG
    from valid_edge a a'  get_return_edges a obtain a'' where "valid_edge a''"
      and "sourcenode a'' = sourcenode a" and "targetnode a'' = targetnode a'"
      and "intra_kind (kind a'')" 
      by(fastforce dest:call_return_node_edge simp:intra_kind_def)
    from valid_edge a' valid_edge a a'  get_return_edges a
    have "call_of_return_node (targetnode a') (sourcenode a)"
      by(fastforce simp:call_of_return_node_def return_node_def)
    show False
    proof(cases msx)
      case Nil
      with ms = msx @ m # msx' ‹hd ms = sourcenode a have [simp]:"m = sourcenode a"
        and "tl ms = msx'" by simp_all
      from Nil ms' = targetnode a # targetnode a' # tl ms ms = msx @ m # msx'
      have "ms' = targetnode a # targetnode a' # msx'" by simp
      from msx' disj ‹tl ms = msx' ‹hd ms = sourcenode a
      have "sourcenode a  HRB_slice SCFG" by fastforce
      from valid_edge a'' ‹intra_kind (kind a'') sourcenode a  HRB_slice SCFG
        sourcenode a'' = sourcenode a targetnode a'' = targetnode a'
      have "obs_intra (targetnode a') HRB_slice SCFG = 
         obs_intra (sourcenode a) HRB_slice SCFG"
        by(fastforce dest:edge_obs_intra_slice_eq)
      with m'  obs_intra m HRB_slice SCFG 
      have "m'  obs_intra (targetnode a') HRB_slice SCFG" by simp
      from this msx' have "m'#msx'  obs (targetnode a'#msx') HRB_slice SCFG"
        by(fastforce intro:obsI)
      from ‹call_of_return_node (targetnode a') (sourcenode a)
        sourcenode a  HRB_slice SCFG
      have "m'  set (targetnode a'#msx').
        mx. call_of_return_node m' mx  mx  HRB_slice SCFG"
        by fastforce
      with m'#msx'  obs (targetnode a'#msx') HRB_slice SCFG
      have "m'#msx'  obs (targetnode a#targetnode a'#msx') HRB_slice SCFG"
        by simp
      with ms' = targetnode a # targetnode a' # msx' ‹obs ms' HRB_slice SCFG = {}
      show False by simp
    next
      case (Cons y ys)
      with ms = msx @ m # msx' ms' = targetnode a # targetnode a' # tl ms 
        ‹hd ms = sourcenode a
      have "ms' = targetnode a # targetnode a' # ys @ m # msx'" 
        and "y = sourcenode a" and "tl ms = ys @ m # msx'" by simp_all
      show False
      proof(cases "obs_intra (targetnode a) HRB_slice SCFG  {}  
          (x''set (targetnode a' # ys @ [m]).
          mx. call_of_return_node x'' mx  mx  HRB_slice SCFG)")
        case True
        hence imp:"obs_intra (targetnode a) HRB_slice SCFG  {} 
          (x''set (targetnode a' # ys @ [m]).
          mx. call_of_return_node x'' mx  mx  HRB_slice SCFG)" .
        show False
        proof(cases "obs_intra (targetnode a') HRB_slice SCFG  {}  
            (x''set (ys @ [m]). mx. call_of_return_node x'' mx  
            mx  HRB_slice SCFG)")
          case True
          with imp msx Cons y = sourcenode a 
          have "xs x xs'. targetnode a # targetnode a' # ys = xs@x#xs'  
            obs_intra x HRB_slice SCFG  {}  (x''set (xs' @ [m]). 
            mx. call_of_return_node x'' mx  mx  HRB_slice SCFG)"
            apply clarsimp apply(case_tac xs) apply fastforce
            apply(case_tac list) apply fastforce apply clarsimp
            apply(erule_tac x="sourcenode a # lista" in allE) apply auto
            done
          with m'  obs_intra m HRB_slice SCFG msx' 
            ms' = targetnode a # targetnode a' # ys @ m # msx'
          have "m'#msx'  obs ms' HRB_slice SCFG" by -(rule obsI,auto)
          with ‹obs ms' HRB_slice SCFG = {} show False by simp
        next
          case False
          hence "obs_intra (targetnode a') HRB_slice SCFG  {}"
            and all:"x''set (ys @ [m]). mx. call_of_return_node x'' mx  
            mx  HRB_slice SCFG"
            by fastforce+
          have "obs_intra (sourcenode a) HRB_slice SCFG  {}"
          proof(cases "sourcenode a  HRB_slice SCFG")
            case True
            from valid_edge a have "valid_node (sourcenode a)" by simp
            from this True 
            have "obs_intra (sourcenode a) HRB_slice SCFG = {sourcenode a}"
              by(rule n_in_obs_intra)
            thus ?thesis by simp
          next
            case False
            with sourcenode a'' = sourcenode a
            have "sourcenode a''  HRB_slice SCFG" by simp
            with valid_edge a'' ‹intra_kind (kind a'')
            have "obs_intra (targetnode a'') HRB_slice SCFG = 
              obs_intra (sourcenode a'') HRB_slice SCFG"
              by(rule edge_obs_intra_slice_eq)
            with ‹obs_intra (targetnode a') HRB_slice SCFG  {} 
              sourcenode a'' = sourcenode a targetnode a'' = targetnode a'
            show ?thesis by fastforce 
          qed
          with msx Cons y = sourcenode a all
          show False by simp blast
        qed
      next
        case False
        hence "obs_intra (targetnode a) HRB_slice SCFG  {}"
          and all:"x''set (targetnode a' # ys @ [m]). 
          mx. call_of_return_node x'' mx  mx  HRB_slice SCFG"
          by fastforce+
        with Cons y = sourcenode a msx 
        have "obs_intra (sourcenode a) HRB_slice SCFG = {}" by auto blast
        from ‹call_of_return_node (targetnode a') (sourcenode a) all
        have "sourcenode a  HRB_slice SCFG" by fastforce
        from valid_edge a have "valid_node (sourcenode a)" by simp
        from this sourcenode a  HRB_slice SCFG 
        have "obs_intra (sourcenode a) HRB_slice SCFG = {sourcenode a}"
          by(rule n_in_obs_intra)
        with ‹obs_intra (sourcenode a) HRB_slice SCFG = {} show False by simp
      qed
    qed
  next
    case (silent_move_return f a s s' Q p f' ms S ms')
    note msx = xs x xs'. msx = xs@x#xs'  obs_intra x HRB_slice SCFG  {}  
      (x''set (xs' @ [m]). mx. call_of_return_node x'' mx  mx  HRB_slice SCFG)
    note msx' = mxset msx'. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG
    show False
    proof(cases msx)
      case Nil
      with ms = msx @ m # msx' ‹hd ms = sourcenode a have  "tl ms = msx'" by simp
      with mset (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG
        msx'
      show False by fastforce
    next
      case (Cons y ys)
      with ms = msx @ m # msx' ‹hd ms = sourcenode a ms' = tl ms
      have "ms' = ys @ m # msx'" and "y = sourcenode a" by simp_all
      from msx Cons have "xs x xs'. ys = xs@x#xs'  
        obs_intra x HRB_slice SCFG  {}   (x''set (xs' @ [m]). 
        mx. call_of_return_node x'' mx  mx  HRB_slice SCFG)"
        by auto (erule_tac x="y # xs" in allE,auto)
      with m'  obs_intra m HRB_slice SCFG msx' ms' = ys @ m # msx'
      have "m'#msx'  obs ms' HRB_slice SCFG" by(rule obsI)
      with ‹obs ms' HRB_slice SCFG = {} show False by simp
    qed
  qed
qed



inductive silent_moves :: 
  "'node SDG_node set  ('edge  ('var,'val,'ret,'pname) edge_kind)  'node list  
  (('var  'val) × 'ret) list  'edge list  'node list  (('var  'val) × 'ret) list  bool"
("_,_  '(_,_') =_τ '(_,_')" [51,50,0,0,50,0,0] 51)

  where silent_moves_Nil: "length ms = length s  S,f  (ms,s) =[]τ (ms,s)"

  | silent_moves_Cons:
  "S,f  (ms,s) -aτ (ms',s'); S,f  (ms',s') =asτ (ms'',s'') 
   S,f  (ms,s) =a#asτ (ms'',s'')"


lemma silent_moves_equal_length:
  assumes "S,f  (ms,s) =asτ (ms',s')" 
  shows "length ms = length s" and "length ms' = length s'"
proof -
  from S,f  (ms,s) =asτ (ms',s') 
  have "length ms = length s  length ms' = length s'"
  proof(induct rule:silent_moves.induct)
    case (silent_moves_Cons S f ms s a ms' s' as ms'' s'')
    from S,f  (ms,s) -aτ (ms',s')
    have "length ms = length s" and "length ms' = length s'" 
      by(rule silent_move_equal_length)+
    with ‹length ms' = length s'  length ms'' = length s''
    show ?case by simp
  qed simp
  thus "length ms = length s" "length ms' = length s'" by simp_all
qed


lemma silent_moves_Append:
  "S,f  (ms,s) =asτ (ms'',s''); S,f  (ms'',s'') =as'τ (ms',s')
   S,f  (ms,s) =as@as'τ (ms',s')"
by(induct rule:silent_moves.induct)(auto intro:silent_moves.intros)


lemma silent_moves_split:
  assumes "S,f  (ms,s) =as@as'τ (ms',s')"
  obtains ms'' s'' where "S,f  (ms,s) =asτ (ms'',s'')"
  and "S,f  (ms'',s'') =as'τ (ms',s')"
proof(atomize_elim)
  from S,f  (ms,s) =as@as'τ (ms',s')
  show "ms'' s''. S,f  (ms,s) =asτ (ms'',s'')  S,f  (ms'',s'') =as'τ (ms',s')"
  proof(induct as arbitrary:ms s)
    case Nil
    from S,f  (ms,s) =[] @ as'τ (ms',s') have "length ms = length s"
      by(fastforce intro:silent_moves_equal_length)
    hence "S,f  (ms,s) =[]τ (ms,s)" by(rule silent_moves_Nil)
    with S,f  (ms,s) =[] @ as'τ (ms',s') show ?case by fastforce
  next
    case (Cons ax asx)
    note IH = ms s. S,f  (ms,s) =asx @ as'τ (ms',s') 
      ms'' s''. S,f  (ms,s) =asxτ (ms'',s'')  S,f  (ms'',s'') =as'τ (ms',s')
    from S,f  (ms,s) =(ax # asx) @ as'τ (ms',s')
    obtain msx sx where "S,f  (ms,s) -axτ (msx,sx)"
      and "S,f  (msx,sx) =asx @ as'τ (ms',s')"
      by(auto elim:silent_moves.cases)
    from IH[OF this(2)] obtain ms'' s'' where "S,f  (msx,sx) =asxτ (ms'',s'')"
      and "S,f  (ms'',s'') =as'τ (ms',s')" by blast
    from S,f  (ms,s) -axτ (msx,sx) S,f  (msx,sx) =asxτ (ms'',s'')
    have "S,f  (ms,s) =ax#asxτ (ms'',s'')" by(rule silent_moves_Cons)
    with S,f  (ms'',s'') =as'τ (ms',s') show ?case by blast
  qed
qed


lemma valid_nodes_silent_moves:
  "S,f (ms,s) =as'τ (ms',s'); m  set ms. valid_node m
   m  set ms'. valid_node m"
proof(induct rule:silent_moves.induct)
  case (silent_moves_Cons S f ms s a ms' s' as ms'' s'')
  note IH = mset ms'. valid_node m  mset ms''. valid_node m
  from S,f  (ms,s) -aτ (ms',s') mset ms. valid_node m
  have "mset ms'. valid_node m"
    apply - apply(erule silent_move.cases) apply auto
    by(cases ms,auto dest:get_return_edges_valid)+
  from IH[OF this] show ?case .
qed simp


lemma return_nodes_silent_moves:
  "S,f  (ms,s) =as'τ (ms',s'); m  set (tl ms). return_node m
   m  set (tl ms'). return_node m"
by(induct rule:silent_moves.induct,auto dest:silent_move_return_node)


lemma silent_moves_intra_path:
  "S,f  (m#ms,s) =asτ (m'#ms',s'); a  set as. intra_kind(kind a)
   ms = ms'  get_proc m = get_proc m'"
proof(induct S f "m#ms" s as "m'#ms'" s' arbitrary:m
  rule:silent_moves.induct)
  case (silent_moves_Cons S f sx a msx' sx' as s'')
  thus ?case
  proof(induct _ _ "m # ms" _ _ _ _ rule:silent_move.induct)
    case (silent_move_intra f a s s' nc msx')
    note IH = m. msx' = m # ms; aset as. intra_kind (kind a)
       ms = ms'  get_proc m = get_proc m'
    from msx' = targetnode a # tl (m # ms)
    have "msx' = targetnode a # ms" by simp
    from aset (a # as). intra_kind (kind a) have "aset as. intra_kind (kind a)"
      by simp
    from IH[OF msx' = targetnode a # ms this]
    have "ms = ms'" and "get_proc (targetnode a) = get_proc m'" by simp_all
    moreover
    from valid_edge a ‹intra_kind (kind a)
    have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
    moreover
    from ‹hd (m # ms) = sourcenode a have "m = sourcenode a" by simp
    ultimately show ?case using ms = ms' by simp
  qed (auto simp:intra_kind_def)
qed simp


lemma silent_moves_nodestack_notempty: 
  "S,f  (ms,s) =asτ (ms',s'); ms  []  ms'  []"
apply(induct S f ms s as ms' s' rule:silent_moves.induct) apply auto
apply(erule silent_move.cases) apply auto
apply(case_tac "tl msa") by auto


lemma silent_moves_obs_slice:
  "S,kind  (ms,s) =asτ (ms',s'); mx  obs ms' HRB_slice SCFG; 
  n  set (tl ms'). return_node n
   mx  obs ms HRB_slice SCFG  (n  set (tl ms). return_node n)"
proof(induct S f"kind" ms s as ms' s' rule:silent_moves.induct)
  case silent_moves_Nil thus ?case by simp
next
  case (silent_moves_Cons S ms s a ms' s' as ms'' s'')
  note IH = mx  obs ms'' HRB_slice SCFG; mset (tl ms''). return_node m
     mx  obs ms' HRB_slice SCFG  (mset (tl ms'). return_node m)
  from IH[OF mx  obs ms'' HRB_slice SCFG mset (tl ms''). return_node m]
  have "mx  obs ms' HRB_slice SCFG" and "mset (tl ms'). return_node m"
    by simp_all
  with S,kind  (ms,s) -aτ (ms',s')
  have "mx  obs ms HRB_slice SCFG" by(fastforce intro:silent_move_obs_slice)
  moreover
  from S,kind  (ms,s) -aτ (ms',s') have "mset (tl ms). return_node m"
    by(fastforce elim:silent_move.cases)
  ultimately show ?case by simp
qed


lemma silent_moves_empty_obs_slice:
  "S,f  (ms,s) =asτ (ms',s'); obs ms' HRB_slice SCFG = {}
   obs ms HRB_slice SCFG = {}"
proof(induct rule:silent_moves.induct)
  case silent_moves_Nil thus ?case by simp
next
  case (silent_moves_Cons S f ms s a ms' s' as ms'' s'')
  note IH = ‹obs ms'' HRB_slice SCFG = {}  obs ms' HRB_slice SCFG = {}
  from IH[OF ‹obs ms'' HRB_slice SCFG = {}]
  have "obs ms' HRB_slice SCFG = {}" by simp
  with S,f  (ms,s) -aτ (ms',s')
  show ?case by -(rule silent_move_empty_obs_slice,fastforce)
qed


lemma silent_moves_preds_transfers:
  assumes "S,f  (ms,s) =asτ (ms',s')"
  shows "preds (map f as) s" and "transfers (map f as) s = s'"
proof -
  from S,f  (ms,s) =asτ (ms',s')
  have "preds (map f as) s  transfers (map f as) s = s'"
  proof(induct rule:silent_moves.induct)
    case silent_moves_Nil thus ?case by simp
  next
    case (silent_moves_Cons S f ms s a ms' s' as ms'' s'')
    from S,f  (ms,s) -aτ (ms',s')
    have "pred (f a) s" and "transfer (f a) s = s'" by(auto elim:silent_move.cases)
    with ‹preds (map f as) s'  transfers (map f as) s' = s''
    show ?case by fastforce
  qed
  thus "preds (map f as) s" and "transfers (map f as) s = s'" by simp_all
qed



lemma silent_moves_intra_path_obs:
  assumes "m'  obs_intra m HRB_slice SCFG" and "length s = length (m#msx')"
  and "m  set msx'. return_node m"
  obtains as' where "S,slice_kind S  (m#msx',s) =as'τ (m'#msx',s)"
proof(atomize_elim)
  from m'  obs_intra m HRB_slice SCFG
  obtain as where "m -asι* m'" and "m'  HRB_slice SCFG"
    by -(erule obs_intraE)
  from m -asι* m' obtain x where "distance m m' x" and "x  length as"
    by(erule every_path_distance)
  from ‹distance m m' x m'  obs_intra m HRB_slice SCFG
    ‹length s = length (m#msx') m  set msx'. return_node m
  show "as. S,slice_kind S  (m#msx',s) =asτ (m'#msx',s)"
  proof(induct x arbitrary:m s rule:nat.induct)
    fix m fix s::"(('var  'val) × 'ret) list"
    assume "distance m m' 0" and "length s = length (m#msx')"
    then obtain as' where "m -as'ι* m'" and "length as' = 0"
      by(auto elim:distance.cases)
    hence "m -[]ι* m'" by(cases as) auto
    hence [simp]:"m = m'" by(fastforce elim:path.cases simp:intra_path_def)
    with ‹length s = length (m#msx')[THEN sym]
    have "S,slice_kind S  (m#msx',s) =[]τ (m#msx',s)" 
      by -(rule silent_moves_Nil)
    thus "as. S,slice_kind S  (m#msx',s) =asτ (m'#msx',s)" by simp blast
  next
    fix x m fix s::"(('var  'val) × 'ret) list"
    assume "distance m m' (Suc x)" and "m'  obs_intra m HRB_slice SCFG"
      and "length s = length (m#msx')" and "m  set msx'. return_node m"
      and IH:"m s. distance m m' x; m'  obs_intra m HRB_slice SCFG;
                     length s = length (m#msx'); m  set msx'. return_node m
       as. S,slice_kind S  (m#msx',s) =asτ (m'#msx',s)"
    from m'  obs_intra m HRB_slice SCFG have "valid_node m"
      by(rule in_obs_intra_valid)
    with ‹distance m m' (Suc x) have "m  m'"
      by(fastforce elim:distance.cases dest:empty_path simp:intra_path_def)
    have "m  HRB_slice SCFG"
    proof
      assume isin:"m  HRB_slice SCFG"
      with ‹valid_node m have "obs_intra m HRB_slice SCFG = {m}"
        by(fastforce intro!:n_in_obs_intra)
      with m'  obs_intra m HRB_slice SCFG m  m' show False by simp
    qed
    from ‹distance m m' (Suc x) obtain a where "valid_edge a" and "m = sourcenode a"
      and "intra_kind(kind a)" and "distance (targetnode a) m' x"
      and target:"targetnode a = (SOME mx. a'. sourcenode a = sourcenode a'  
                                               distance (targetnode a') m' x 
                                               valid_edge a'  intra_kind (kind a')  
                                               targetnode a' = mx)"
      by -(erule distance_successor_distance,simp+)
    from m'  obs_intra m HRB_slice SCFG 
    have "obs_intra m HRB_slice SCFG = {m'}"
      by(rule obs_intra_singleton_element)
    with valid_edge a m  HRB_slice SCFG m = sourcenode a ‹intra_kind(kind a)
    have disj:"obs_intra (targetnode a) HRB_slice SCFG = {}  
               obs_intra (targetnode a) HRB_slice SCFG = {m'}"
      by -(drule_tac S="HRB_slice SCFG" in edge_obs_intra_subset,auto)
    from ‹intra_kind(kind a) ‹length s = length (m#msx') m  HRB_slice SCFG 
      m = sourcenode a
    have length:"length (transfer (slice_kind S a) s) = length (targetnode a#msx')"
      by(cases s)
    (auto split:if_split_asm simp add:Let_def slice_kind_def intra_kind_def)
    from ‹distance (targetnode a) m' x obtain asx where "targetnode a -asxι* m'" 
      and "length asx = x" and "as'. targetnode a -as'ι* m'  x  length as'"
      by(auto elim:distance.cases)
    from targetnode a -asxι* m' m'  HRB_slice SCFG
    obtain mx where "mx  obs_intra (targetnode a) HRB_slice SCFG" 
      by(erule path_ex_obs_intra)
    with disj have "m'  obs_intra (targetnode a) HRB_slice SCFG" by fastforce
    from IH[OF ‹distance (targetnode a) m' x this length 
      m  set msx'. return_node m]
    obtain asx' where moves:"S,slice_kind S  
      (targetnode a#msx',transfer (slice_kind S a) s) =asx'τ 
      (m'#msx',transfer (slice_kind S a) s)" by blast
    have "pred (slice_kind S a) s  transfer (slice_kind S a) s = s"
    proof(cases "kind a")
      fix f assume "kind a = f"
      with m  HRB_slice SCFG m = sourcenode a have "slice_kind S a = id"
        by(fastforce intro:slice_kind_Upd)
      with ‹length s = length (m#msx') show ?thesis by(cases s) auto
    next
      fix Q assume "kind a = (Q)"
      with m  HRB_slice SCFG m = sourcenode a
        m'  obs_intra m HRB_slice SCFG ‹distance (targetnode a) m' x
        ‹distance m m' (Suc x) target
      have "slice_kind S a = (λs. True)"
        by(fastforce intro:slice_kind_Pred_obs_nearer_SOME)
      with ‹length s = length (m#msx') show ?thesis by(cases s) auto
    next
      fix Q r p fs assume "kind a = Q:rpfs"
      with ‹intra_kind(kind a) have False by(simp add:intra_kind_def)
      thus ?thesis by simp
    next
      fix Q p f assume "kind a = Qpf"
      with ‹intra_kind(kind a) have False by(simp add:intra_kind_def)
      thus ?thesis by simp
    qed
    hence "pred (slice_kind S a) s" and "transfer (slice_kind S a) s = s"
      by simp_all
    with m  HRB_slice SCFG m = sourcenode a valid_edge a
      ‹intra_kind(kind a) ‹length s = length (m#msx') m  set msx'. return_node m
    have "S,slice_kind S  (sourcenode a#msx',s) -aτ 
                             (targetnode a#msx',transfer (slice_kind S a) s)"
      by(fastforce intro:silent_move_intra)
    with moves ‹transfer (slice_kind S a) s = s m = sourcenode a
    have "S,slice_kind S  (m#msx',s) =a#asx'τ (m'#msx',s)"
      by(fastforce intro:silent_moves_Cons)
    thus "as. S,slice_kind S  (m#msx',s) =asτ (m'#msx',s)" by blast
  qed
qed


lemma silent_moves_intra_path_no_obs:
  assumes "obs_intra m HRB_slice SCFG = {}" and "method_exit m'"
  and "get_proc m = get_proc m'" and "valid_node m" and "length s = length (m#msx')"
  and "m  set msx'. return_node m"
  obtains as where "S,slice_kind S  (m#msx',s) =asτ (m'#msx',s)"
proof(atomize_elim)
  from ‹method_exit m' get_proc m = get_proc m' ‹valid_node m
  obtain as where "m -asι* m'" by(erule intra_path_to_matching_method_exit)
  then obtain x where "distance m m' x" and "x  length as"
    by(erule every_path_distance)
  from ‹distance m m' x m -asι* m' ‹obs_intra m HRB_slice SCFG = {}
    ‹length s = length (m#msx') m  set msx'. return_node m
  show "as. S,slice_kind S  (m#msx',s) =asτ (m'#msx',s)"
  proof(induct x arbitrary:m as s rule:nat.induct)
    fix m fix s::"(('var  'val) × 'ret) list"
    assume "distance m m' 0" and "length s = length (m#msx')"
    then obtain as' where "m -as'ι* m'" and "length as' = 0"
      by(auto elim:distance.cases)
    hence "m -[]ι* m'" by(cases as) auto
    hence [simp]:"m = m'" by(fastforce elim:path.cases simp:intra_path_def)
    with ‹length s = length (m#msx')[THEN sym]
    have "S,slice_kind S  (m#msx',s) =[]τ (m#msx',s)" 
      by(fastforce intro:silent_moves_Nil)
    thus "as. S,slice_kind S  (m#msx',s) =asτ (m'#msx',s)" by simp blast
  next
    fix x m as fix s::"(('var  'val) × 'ret) list"
    assume "distance m m' (Suc x)" and "m -asι* m'"
      and "obs_intra m HRB_slice SCFG = {}"
      and "length s = length (m#msx')" and "m  set msx'. return_node m"
      and IH:"m as s. distance m m' x; m -asι* m'; 
      obs_intra m HRB_slice SCFG = {}; length s = length (m#msx'); 
      m  set msx'. return_node m
       as. S,slice_kind S  (m#msx',s) =asτ (m'#msx',s)"
    from m -asι* m' have "valid_node m" 
      by(fastforce intro:path_valid_node simp:intra_path_def)
    from m -asι* m' have "get_proc m = get_proc m'" by(rule intra_path_get_procs)
    have "m  HRB_slice SCFG"
    proof
      assume "m  HRB_slice SCFG"
      with ‹valid_node m have "obs_intra m HRB_slice SCFG = {m}"
        by(fastforce intro!:n_in_obs_intra)
      with ‹obs_intra m HRB_slice SCFG = {} show False by simp
    qed
    from ‹distance m m' (Suc x) obtain a where "valid_edge a" and "m = sourcenode a"
      and "intra_kind(kind a)" and "distance (targetnode a) m' x"
      and target:"targetnode a = (SOME mx. a'. sourcenode a = sourcenode a'  
                                               distance (targetnode a') m' x 
                                               valid_edge a'  intra_kind (kind a')  
                                               targetnode a' = mx)"
      by -(erule distance_successor_distance,simp+)
    from ‹intra_kind(kind a) ‹length s = length (m#msx') m  HRB_slice SCFG 
      m = sourcenode a
    have length:"length (transfer (slice_kind S a) s) = length (targetnode a#msx')"
      by(cases s)
    (auto split:if_split_asm simp add:Let_def slice_kind_def intra_kind_def)
    from ‹distance (targetnode a) m' x obtain asx where "targetnode a -asxι* m'" 
      and "length asx = x" and "as'. targetnode a -as'ι* m'  x  length as'"
      by(auto elim:distance.cases)
    from valid_edge a ‹intra_kind(kind a) m  HRB_slice SCFG 
      m = sourcenode a ‹obs_intra m HRB_slice SCFG = {}
    have "obs_intra (targetnode a) HRB_slice SCFG = {}"
      by(fastforce dest:edge_obs_intra_subset)
    from IH[OF ‹distance (targetnode a) m' x targetnode a -asxι* m' this
      length m  set msx'. return_node m] obtain as' 
      where moves:"S,slice_kind S  
      (targetnode a#msx',transfer (slice_kind S a) s) =as'τ 
      (m'#msx',transfer (slice_kind S a) s)" by blast
    have "pred (slice_kind S a) s  transfer (slice_kind S a) s = s"
    proof(cases "kind a")
      fix f assume "kind a = f"
      with m  HRB_slice SCFG m = sourcenode a have "slice_kind S a = id"
        by(fastforce intro:slice_kind_Upd)
      with ‹length s = length (m#msx') show ?thesis by(cases s) auto
    next
      fix Q assume "kind a = (Q)"
      with m  HRB_slice SCFG m = sourcenode a
        ‹obs_intra m HRB_slice SCFG = {} ‹distance (targetnode a) m' x
        ‹distance m m' (Suc x) ‹method_exit m' get_proc m = get_proc m' target
      have "slice_kind S a = (λs. True)"
        by(fastforce intro:slice_kind_Pred_empty_obs_nearer_SOME)
     with ‹length s = length (m#msx') show ?thesis by(cases s) auto
    next
      fix Q r p fs assume "kind a = Q:rpfs"
      with ‹intra_kind(kind a) have False by(simp add:intra_kind_def)
      thus ?thesis by simp
    next
      fix Q p f assume "kind a = Qpf"
      with ‹intra_kind(kind a) have False by(simp add:intra_kind_def)
      thus ?thesis by simp
    qed
    hence "pred (slice_kind S a) s" and "transfer (slice_kind S a) s = s"
      by simp_all
    with m  HRB_slice SCFG m = sourcenode a valid_edge a
      ‹intra_kind(kind a) ‹length s = length (m#msx') m  set msx'. return_node m
    have "S,slice_kind S  (sourcenode a#msx',s) -aτ 
                             (targetnode a#msx',transfer (slice_kind S a) s)"
      by(fastforce intro:silent_move_intra)
    with moves ‹transfer (slice_kind S a) s = s m = sourcenode a
    have "S,slice_kind S  (m#msx',s) =a#as'τ (m'#msx',s)"
      by(fastforce intro:silent_moves_Cons)
    thus "as. S,slice_kind S  (m#msx',s) =asτ (m'#msx',s)" by blast
  qed
qed


lemma silent_moves_vpa_path:
  assumes "S,f  (m#ms,s) =asτ (m'#ms',s')" and "valid_node m"
  and "i < length rs. rs!i  get_return_edges (cs!i)" 
  and "ms = targetnodes rs" and "valid_return_list rs m"
  and "length rs = length cs"
  shows "m -as→* m'" and "valid_path_aux cs as"
proof -
  from assms have "m -as→* m'  valid_path_aux cs as"
  proof(induct S f "m#ms" s as "m'#ms'" s' arbitrary:m cs ms rs
      rule:silent_moves.induct)
    case (silent_moves_Nil msx sx nc f)
    from ‹valid_node m' have "m' -[]→* m'"
      by (rule empty_path)
    thus ?case by fastforce
  next
    case (silent_moves_Cons S f sx a msx' sx' as s'')
    thus ?case
    proof(induct _ _ "m # ms" _ _ _ _ rule:silent_move.induct)
      case (silent_move_intra f a sx sx' nc msx')
      note IH = m cs ms rs. msx' = m # ms; valid_node m;
        i<length rs. rs ! i  get_return_edges (cs ! i); 
        ms = targetnodes rs; valid_return_list rs m;
        length rs = length cs
         m -as→* m'  valid_path_aux cs as
      from msx' = targetnode a # tl (m # ms)
      have "msx' = targetnode a # ms" by simp
      from valid_edge a ‹intra_kind (kind a)
      have "get_proc (sourcenode a) = get_proc (targetnode a)"
        by(rule get_proc_intra)
      with ‹valid_return_list rs m ‹hd (m # ms) = sourcenode a
      have "valid_return_list rs (targetnode a)"
        apply(clarsimp simp:valid_return_list_def)
        apply(erule_tac x="cs'" in allE) apply clarsimp
        by(case_tac cs') auto
      from valid_edge a have "valid_node (targetnode a)" by simp
      from IH[OF msx' = targetnode a # ms this 
        i<length rs. rs ! i  get_return_edges (cs ! i)
        ms = targetnodes rs ‹valid_return_list rs (targetnode a)
        ‹length rs = length cs]
      have "targetnode a -as→* m'" and "valid_path_aux cs as" by simp_all
      from valid_edge a targetnode a -as→* m' 
        ‹hd (m # ms) = sourcenode a
      have "m -a#as→* m'" by(fastforce intro:Cons_path)
      moreover
      from ‹intra_kind (kind a) ‹valid_path_aux cs as
      have "valid_path_aux cs (a # as)" by(fastforce simp:intra_kind_def)
      ultimately show ?case by simp
    next
      case (silent_move_call f a sx sx' Q r p fs a' nc msx')
      note IH = m cs ms rs. msx' = m # ms; valid_node m;
        i<length rs. rs ! i  get_return_edges (cs ! i); 
        ms = targetnodes rs; valid_return_list rs m;
        length rs = length cs
         m -as→* m'  valid_path_aux cs as
      from valid_edge a have "valid_node (targetnode a)" by simp
      from ‹length rs = length cs 
      have "length (a'#rs) = length (a#cs)" by simp
      from msx' = targetnode a # targetnode a' # tl (m # ms)
      have "msx' = targetnode a # targetnode a' # ms" by simp
      from ms = targetnodes rs have "targetnode a' # ms = targetnodes (a' # rs)"
        by(simp add:targetnodes_def)
      from valid_edge a kind a = Q:rpfs have "get_proc (targetnode a) = p"
        by(rule get_proc_call)
      from valid_edge a a'  get_return_edges a have "valid_edge a'"
        by(rule get_return_edges_valid)
      from valid_edge a kind a = Q:rpfs a'  get_return_edges a
      obtain Q' f' where "kind a' = Q'pf'" by(fastforce dest!:call_return_edges)
      from valid_edge a a'  get_return_edges a
      have "get_proc (sourcenode a) = get_proc (targetnode a')"
        by(rule get_proc_get_return_edge)
      with ‹valid_return_list rs m ‹hd (m # ms) = sourcenode a
        get_proc (targetnode a) = p valid_edge a' kind a' = Q'pf'
      have "valid_return_list (a' # rs) (targetnode a)"
        apply(clarsimp simp:valid_return_list_def)
        apply(case_tac cs') apply auto
        apply(erule_tac x="list" in allE) apply clarsimp
        by(case_tac list)(auto simp:targetnodes_def)
      from i<length rs. rs ! i  get_return_edges (cs ! i) 
        a'  get_return_edges a
      have "i<length (a'#rs). (a'#rs) ! i  get_return_edges ((a#cs) ! i)"
        by auto(case_tac i,auto)
      from IH[OF msx' = targetnode a # targetnode a' # ms ‹valid_node (targetnode a) this 
        targetnode a' # ms = targetnodes (a' # rs) 
        ‹valid_return_list (a' # rs) (targetnode a) ‹length (a'#rs) = length (a#cs)]
      have "targetnode a -as→* m'" and "valid_path_aux (a # cs) as" by simp_all
      from valid_edge a targetnode a -as→* m' 
        ‹hd (m # ms) = sourcenode a
      have "m -a#as→* m'" by(fastforce intro:Cons_path)
      moreover
      from ‹valid_path_aux (a # cs) as kind a = Q:rpfs
      have "valid_path_aux cs (a # as)" by simp
      ultimately show ?case by simp
    next
      case (silent_move_return f a sx sx' Q p f' nc msx')
      note IH = m cs ms rs. msx' = m # ms; valid_node m;
        i<length rs. rs ! i  get_return_edges (cs ! i); 
        ms = targetnodes rs; valid_return_list rs m;
        length rs = length cs
         m -as→* m'  valid_path_aux cs as
      from valid_edge a have "valid_node (targetnode a)" by simp
      from ‹length (m # ms) = length sx ‹length sx = Suc (length sx') 
        sx'  []
      obtain x xs where "ms = x#xs" by(cases ms) auto
      with ms = targetnodes rs obtain r' rs' where "rs = r'#rs'" 
        and "x = targetnode r'" and "xs = targetnodes rs'" 
        by(auto simp:targetnodes_def)
      with ‹length rs = length cs obtain c' cs' where "cs = c'#cs'"
        and "length rs' = length cs'"
        by(cases cs) auto
      from ms = x#xs ‹length (m # ms) = length sx 
        ‹length sx = Suc (length sx')
      have "length sx' = Suc (length xs)" by simp
      from ms = x#xs msx' = tl (m # ms) ‹hd (tl (m # ms)) = targetnode a
        ‹length (m # ms) = length sx ‹length sx = Suc (length sx') sx'  []
      have "msx' = targetnode a#xs" by simp
      from i<length rs. rs ! i  get_return_edges (cs ! i) 
        rs = r'#rs' cs = c'#cs'
      have "r'  get_return_edges c'" by fastforce
      from ms = x#xs ‹hd (tl (m # ms)) = targetnode a
      have "x = targetnode a" by simp
      with ‹valid_return_list rs m rs = r'#rs' x = targetnode r'
      have "valid_return_list rs' (targetnode a)"
        apply(clarsimp simp:valid_return_list_def)
        apply(erule_tac x="r'#cs'" in allE) apply clarsimp
        by(case_tac cs')(auto simp:targetnodes_def)
      from i<length rs. rs ! i  get_return_edges (cs ! i) 
        rs = r'#rs' cs = c'#cs'
      have "i<length rs'. rs' ! i  get_return_edges (cs' ! i)"
        and "r'  get_return_edges c'" by auto
      from IH[OF msx' = targetnode a#xs ‹valid_node (targetnode a) 
        i<length rs'. rs' ! i  get_return_edges (cs' ! i) xs = targetnodes rs'
        ‹valid_return_list rs' (targetnode a) ‹length rs' = length cs']
      have "targetnode a -as→* m'" and "valid_path_aux cs' as" by simp_all
      from valid_edge a targetnode a -as→* m' 
        ‹hd (m # ms) = sourcenode a
      have "m -a#as→* m'" by(fastforce intro:Cons_path)
      moreover
      from ms = x#xs ‹hd (tl (m # ms)) = targetnode a
      have "x = targetnode a" by simp
      from valid_edge a kind a = Qpf'
      have "method_exit (sourcenode a)" by(fastforce simp:method_exit_def)
      from ‹valid_return_list rs m ‹hd (m # ms) = sourcenode a 
        rs = r'#rs'
      have "get_proc (sourcenode a) = get_proc (sourcenode r') 
        method_exit (sourcenode r')  valid_edge r'"
        apply(clarsimp simp:valid_return_list_def method_exit_def)
        apply(erule_tac x="[]" in allE) 
        by(auto dest:get_proc_return)
      hence "get_proc (sourcenode a) = get_proc (sourcenode r')"
        and "method_exit (sourcenode r')" and "valid_edge r'" by simp_all
      with ‹method_exit (sourcenode a) have "sourcenode r' = sourcenode a"
        by(fastforce intro:method_exit_unique)
      with valid_edge a valid_edge r' x = targetnode r' x = targetnode a
      have "r' = a" by(fastforce intro:edge_det)
      with r'  get_return_edges c' ‹valid_path_aux cs' as cs = c'#cs' 
        kind a = Qpf'
      have "valid_path_aux cs (a # as)" by simp
      ultimately show ?case by simp
    qed
  qed
  thus "m -as→* m'" and "valid_path_aux cs as" by simp_all
qed



subsection ‹Observable moves›


inductive observable_move ::
  "'node SDG_node set  ('edge  ('var,'val,'ret,'pname) edge_kind)  'node list  
   (('var  'val) × 'ret) list  'edge  'node list  (('var  'val) × 'ret) list  bool"
("_,_  '(_,_') -_ '(_,_')" [51,50,0,0,50,0,0] 51) 
 
  where observable_move_intra:
  "pred (f a) s; transfer (f a) s = s'; valid_edge a; intra_kind(kind a); 
    m  set (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG;
    hd ms  HRB_slice SCFG; length s' = length s; length ms = length s;
    hd ms = sourcenode a; ms' = (targetnode a)#tl ms  
   S,f  (ms,s) -a (ms',s')"

  | observable_move_call:
  "pred (f a) s; transfer (f a) s = s'; valid_edge a; kind a = Q:rpfs; 
    valid_edge a'; a'  get_return_edges a;
    m  set (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG;
    hd ms  HRB_slice SCFG; length ms = length s; length s' = Suc(length s); 
    hd ms = sourcenode a; ms' = (targetnode a)#(targetnode a')#tl ms  
   S,f  (ms,s) -a (ms',s')"

  | observable_move_return:
  "pred (f a) s; transfer (f a) s = s'; valid_edge a; kind a = Qpf'; 
    m  set (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG;
    length ms = length s; length s = Suc(length s'); s'  [];
    hd ms = sourcenode a; hd(tl ms) = targetnode a; ms' = tl ms  
   S,f  (ms,s) -a (ms',s')"



inductive observable_moves :: 
  "'node SDG_node set  ('edge  ('var,'val,'ret,'pname) edge_kind)  'node list  
   (('var  'val) × 'ret) list  'edge list  'node list  (('var  'val) × 'ret) list  bool"
("_,_  '(_,_') =_ '(_,_')" [51,50,0,0,50,0,0] 51) 

  where observable_moves_snoc:
  "S,f  (ms,s) =asτ (ms',s'); S,f  (ms',s') -a (ms'',s'') 
   S,f  (ms,s) =as@[a] (ms'',s'')"


lemma observable_move_equal_length:
  assumes "S,f  (ms,s) -a (ms',s')" 
  shows "length ms = length s" and "length ms' = length s'"
proof -
  from S,f  (ms,s) -a (ms',s')
  have "length ms = length s  length ms' = length s'"
  proof(induct rule:observable_move.induct)
    case (observable_move_intra f a s s' ms S ms')
    from ‹pred (f a) s obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
    from ‹length ms = length s ms' = targetnode a # tl ms
      ‹length s' = length s show ?case by simp
  next
    case (observable_move_call f a s s' Q r p fs a' ms S ms')
    from ‹pred (f a) s obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
    from ‹length ms = length s ‹length s' = Suc (length s) 
      ms' = targetnode a # targetnode a' # tl ms show ?case by simp
  next
    case (observable_move_return f a s s' Q p f' ms S ms')
    from ‹length ms = length s ‹length s = Suc (length s') ms' = tl ms s'  []
    show ?case by simp
  qed
  thus "length ms = length s" and "length ms' = length s'" by simp_all
qed


lemma observable_moves_equal_length:
  assumes "S,f  (ms,s) =as (ms',s')" 
  shows "length ms = length s" and "length ms' = length s'"
  using S,f  (ms,s) =as (ms',s')
proof(induct rule:observable_moves.induct)
  case (observable_moves_snoc S f ms s as ms' s' a ms'' s'')
  from S,f  (ms',s') -a (ms'',s'')
  have "length ms' = length s'" "length ms'' = length s''"
    by(rule observable_move_equal_length)+
  moreover
  from S,f  (ms,s) =asτ (ms',s') 
  have "length ms = length s" and "length ms' = length s'"
    by(rule silent_moves_equal_length)+
  ultimately show "length ms = length s" "length ms'' = length s''" by simp_all
qed


lemma observable_move_notempty:
  "S,f  (ms,s) =as (ms',s'); as = []  False"
by(induct rule:observable_moves.induct,simp)


lemma silent_move_observable_moves:
  "S,f  (ms'',s'') =as (ms',s'); S,f  (ms,s) -aτ (ms'',s'')
   S,f  (ms,s) =a#as (ms',s')"
proof(induct rule:observable_moves.induct)
  case (observable_moves_snoc S f msx sx as ms' s' a' ms'' s'')
  from S,f  (ms,s) -aτ (msx,sx) S,f  (msx,sx) =asτ (ms',s')
  have "S,f  (ms,s) =a#asτ (ms',s')" by(fastforce intro:silent_moves_Cons)
  with S,f  (ms',s') -a' (ms'',s'')
  have "S,f  (ms,s) =(a#as)@[a'] (ms'',s'')"
    by(fastforce intro:observable_moves.observable_moves_snoc)
  thus ?case by simp
qed


lemma silent_append_observable_moves:
  "S,f  (ms,s) =asτ (ms'',s''); S,f  (ms'',s'') =as' (ms',s')
   S,f  (ms,s) =as@as' (ms',s')"
by(induct rule:silent_moves.induct)(auto elim:silent_move_observable_moves)


lemma observable_moves_preds_transfers:
  assumes "S,f  (ms,s) =as (ms',s')"
  shows "preds (map f as) s" and "transfers (map f as) s = s'"
proof -
  from S,f  (ms,s) =as (ms',s')
  have "preds (map f as) s  transfers (map f as) s = s'"
  proof(induct rule:observable_moves.induct)
    case (observable_moves_snoc S f ms s as ms' s' a ms'' s'')
    from S,f  (ms,s) =asτ (ms',s') 
    have "preds (map f as) s" and "transfers (map f as) s = s'"
      by(rule silent_moves_preds_transfers)+
    from S,f  (ms',s') -a (ms'',s'')
    have "pred (f a) s'" and "transfer (f a) s' = s''" 
      by(auto elim:observable_move.cases)
    with ‹preds (map f as) s ‹transfers (map f as) s = s'
    show ?case by(simp add:preds_split transfers_split)
  qed
  thus "preds (map f as) s" and "transfers (map f as) s = s'" by simp_all
qed


lemma observable_move_vpa_path:
  "S,f  (m#ms,s) -a (m'#ms',s'); valid_node m; 
    i < length rs. rs!i  get_return_edges (cs!i); ms = targetnodes rs;
    valid_return_list rs m; length rs = length cs  valid_path_aux cs [a]"
proof(induct S f "m#ms" s a "m'#ms'" s' rule:observable_move.induct)
  case (observable_move_return f a sx sx' Q p f' nc)
  from ‹length (m # ms) = length sx ‹length sx = Suc (length sx') 
    sx'  []
  obtain x xs where "ms = x#xs" by(cases ms) auto
  with ms = targetnodes rs obtain r' rs' where "rs = r'#rs'" 
    and "x = targetnode r'"     and "xs = targetnodes rs'" 
    by(auto simp:targetnodes_def)
  with ‹length rs = length cs obtain c' cs' where "cs = c'#cs'"
    and "length rs' = length cs'"
    by(cases cs) auto
  from i<length rs. rs ! i  get_return_edges (cs ! i) 
    rs = r'#rs' cs = c'#cs'
  have "i<length rs'. rs' ! i  get_return_edges (cs' ! i)"
    and "r'  get_return_edges c'" by auto
  from ms = x#xs ‹hd (tl (m # ms)) = targetnode a
  have "x = targetnode a" by simp
  from valid_edge a kind a = Qpf'
  have "method_exit (sourcenode a)" by(fastforce simp:method_exit_def)
  from ‹valid_return_list rs m ‹hd (m # ms) = sourcenode a 
    rs = r'#rs'
  have "get_proc (sourcenode a) = get_proc (sourcenode r') 
    method_exit (sourcenode r')  valid_edge r'"
    apply(clarsimp simp:valid_return_list_def method_exit_def)
    apply(erule_tac x="[]" in allE) 
    by(auto dest:get_proc_return)
  hence "get_proc (sourcenode a) = get_proc (sourcenode r')"
    and "method_exit (sourcenode r')" and "valid_edge r'" by simp_all
  with ‹method_exit (sourcenode a) have "sourcenode r' = sourcenode a"
    by(fastforce intro:method_exit_unique)
  with valid_edge a valid_edge r' x = targetnode r' x = targetnode a
  have "r' = a" by(fastforce intro:edge_det)
  with r'  get_return_edges c' cs = c'#cs' kind a = Qpf'
  show ?case by simp
qed(auto simp:intra_kind_def)
  


subsection ‹Relevant variables›

inductive_set relevant_vars ::
  "'node SDG_node set  'node SDG_node  'var set" ("rv _")
for S :: "'node SDG_node set" and n :: "'node SDG_node"

where rvI:
  "parent_node n -asι* parent_node n'; n'  HRB_slice S; V  UseSDG n';
    n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as) 
           V  DefSDG n''
   V  rv S n"


lemma rvE:
  assumes rv:"V  rv S n"
  obtains as n' where "parent_node n -asι* parent_node n'"
  and "n'  HRB_slice S" and "V  UseSDG n'"
  and "n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as) 
     V  DefSDG n''"
using rv
by(atomize_elim,auto elim!:relevant_vars.cases)


lemma rv_parent_node:
  "parent_node n = parent_node n'  rv (S::'node SDG_node set) n = rv S n'"
by(fastforce elim:rvE intro:rvI)


lemma obs_intra_empty_rv_empty:
  assumes "obs_intra m HRB_slice SCFG = {}" shows "rv S (CFG_node m) = {}"
proof(rule ccontr)
  assume "rv S (CFG_node m)  {}"
  then obtain x where "x  rv S (CFG_node m)" by fastforce
  then obtain n' as where "m -asι* parent_node n'" and "n'  HRB_slice S"
    by(fastforce elim:rvE)
  hence "parent_node n'  HRB_slice SCFG"
    by(fastforce intro:valid_SDG_node_in_slice_parent_node_in_slice 
                 simp:SDG_to_CFG_set_def)
  with m -asι* parent_node n' obtain mx where "mx  obs_intra m HRB_slice SCFG"
    by(erule path_ex_obs_intra)
  with ‹obs_intra m HRB_slice SCFG = {} show False by simp
qed


lemma eq_obs_intra_in_rv:
  assumes obs_eq:"obs_intra (parent_node n) HRB_slice SCFG = 
                  obs_intra (parent_node n') HRB_slice SCFG"
  and "x  rv S n" shows "x  rv S n'"
proof -
  from x  rv S n obtain as n''
    where "parent_node n -asι* parent_node n''" and "n''  HRB_slice S" 
    and "x  UseSDG n''" 
    and "n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as) 
       x  DefSDG n''"
    by(erule rvE)
  from ‹parent_node n -asι* parent_node n'' have "valid_node (parent_node n'')"
    by(fastforce dest:path_valid_node simp:intra_path_def)
  from ‹parent_node n -asι* parent_node n'' n''  HRB_slice S
  have "nx as' as''. parent_node nx  obs_intra (parent_node n) HRB_slice SCFG  
                      parent_node n -as'ι* parent_node nx 
                      parent_node nx -as''ι* parent_node n''  as = as'@as''"
  proof(cases "nx. parent_node nx  set (sourcenodes as)  nx  HRB_slice S")
    case True
    with ‹parent_node n -asι* parent_node n'' n''  HRB_slice S
    have "parent_node n''  obs_intra (parent_node n) HRB_slice SCFG"
      by(fastforce intro:obs_intra_elem valid_SDG_node_in_slice_parent_node_in_slice 
                   simp:SDG_to_CFG_set_def)
    with ‹parent_node n -asι* parent_node n'' ‹valid_node (parent_node n'')
    show ?thesis by(fastforce intro:empty_path simp:intra_path_def)
  next
    case False
    hence "nx. parent_node nx  set (sourcenodes as)  nx  HRB_slice S" by simp
    hence "mx  set (sourcenodes as). nx. mx = parent_node nx  nx  HRB_slice S"
      by fastforce
    then obtain mx ms ms' where "sourcenodes as = ms@mx#ms'"
      and "nx. mx = parent_node nx  nx  HRB_slice S"
      and all:"x  set ms. ¬ (nx. x = parent_node nx  nx  HRB_slice S)"
      by(fastforce elim!:split_list_first_propE)
    then obtain nx' where "mx = parent_node nx'" and "nx'  HRB_slice S" by blast
    from ‹sourcenodes as = ms@mx#ms'
    obtain as' a' as'' where "ms = sourcenodes as'"
      and [simp]:"as = as'@a'#as''" and "sourcenode a' = mx"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from all ms = sourcenodes as' 
    have "nxset (sourcenodes as'). nx  HRB_slice SCFG"
      by(fastforce simp:SDG_to_CFG_set_def)
    from ‹parent_node n -asι* parent_node n'' sourcenode a' = mx
    have "parent_node n  -as'ι* mx" and "valid_edge a'" and "intra_kind(kind a')"
      and "targetnode a' -as''ι* parent_node n''"
      by(fastforce dest:path_split simp:intra_path_def)+
    with sourcenode a' = mx have "mx -a'#as''ι* parent_node n''"
      by(fastforce intro:Cons_path simp:intra_path_def)
    from ‹parent_node n -as'ι* mx mx = parent_node nx' nx'  HRB_slice S
      nxset (sourcenodes as'). nx  HRB_slice SCFG ms = sourcenodes as'
    have "mx  obs_intra (parent_node n) HRB_slice SCFG"
      by(fastforce intro:obs_intra_elem valid_SDG_node_in_slice_parent_node_in_slice
                   simp:SDG_to_CFG_set_def)
    with ‹parent_node n -as'ι* mx mx -a'#as''ι* parent_node n''
      mx = parent_node nx'
    show ?thesis by simp blast
  qed
  then obtain nx as' as'' 
    where "parent_node nx  obs_intra (parent_node n) HRB_slice SCFG"
    and "parent_node n -as'ι* parent_node nx" 
    and "parent_node nx -as''ι* parent_node n''" and [simp]:"as = as'@as''"
    by blast
  from ‹parent_node nx  obs_intra (parent_node n) HRB_slice SCFG obs_eq
  have "parent_node nx  obs_intra (parent_node n') HRB_slice SCFG" by auto
  then obtain asx where "parent_node n' -asxι* parent_node nx" 
    and "ni  set(sourcenodes asx). ni  HRB_slice SCFG" 
    and "parent_node nx  HRB_slice SCFG"
    by(erule obs_intraE)
  from n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as) 
     x  DefSDG n''
  have "ni. valid_SDG_node ni  parent_node ni  set (sourcenodes as'') 
     x  DefSDG ni"
    by(auto simp:sourcenodes_def)
  from ni  set(sourcenodes asx). ni  HRB_slice SCFG
    ‹parent_node n' -asxι* parent_node nx
  have "ni. valid_SDG_node ni  parent_node ni  set (sourcenodes asx) 
     x  DefSDG ni"
  proof(induct asx arbitrary:n')
    case Nil thus ?case by(simp add:sourcenodes_def)
  next
    case (Cons ax' asx')
    note IH = n'. niset (sourcenodes asx'). ni  HRB_slice SCFG;
      parent_node n' -asx'ι* parent_node nx
       ni. valid_SDG_node ni  parent_node ni  set (sourcenodes asx') 
               x  DefSDG ni
    from ‹parent_node n' -ax'#asx'ι* parent_node nx
    have "parent_node n' -[]@ax'#asx'→* parent_node nx" 
      and "a  set (ax'#asx'). intra_kind(kind a)" by(simp_all add:intra_path_def)
    hence "targetnode ax' -asx'→* parent_node nx" and "valid_edge ax'"
      and "parent_node n' = sourcenode ax'" by(fastforce dest:path_split)+
    with a  set (ax'#asx'). intra_kind(kind a)
    have path:"parent_node (CFG_node (targetnode ax')) -asx'ι* parent_node nx"
      by(simp add:intra_path_def)
    from niset (sourcenodes (ax'#asx')). ni  HRB_slice SCFG
    have all:"niset (sourcenodes asx'). ni  HRB_slice SCFG"
      and "sourcenode ax'  HRB_slice SCFG"
      by(auto simp:sourcenodes_def)
    from IH[OF all path] 
    have "ni. valid_SDG_node ni  parent_node ni  set (sourcenodes asx') 
                x  DefSDG ni" .
    with ni. valid_SDG_node ni  parent_node ni  set (sourcenodes as'') 
                x  DefSDG ni
    have all:"ni. valid_SDG_node ni  parent_node ni  set (sourcenodes (asx'@as'')) 
                    x  DefSDG ni"
      by(auto simp:sourcenodes_def)
    from ‹parent_node n' -ax'#asx'ι* parent_node nx 
      ‹parent_node nx -as''ι* parent_node n''
    have path:"parent_node n' -ax'#asx'@as''ι* parent_node n''"
      by(fastforce intro:path_Append[of _ "ax'#asx'",simplified] simp:intra_path_def)
    have "nx'. parent_node nx' = sourcenode ax'  x  DefSDG nx'"
    proof
      fix nx' 
      show "parent_node nx' = sourcenode ax'  x  DefSDG nx'"
      proof
        assume "parent_node nx' = sourcenode ax'"
        show "x  DefSDG nx'"
        proof
          assume "x  DefSDG nx'"
          from ‹parent_node n' = sourcenode ax' ‹parent_node nx' = sourcenode ax'
          have "parent_node nx' = parent_node n'" by simp
          with x  DefSDG nx' x  UseSDG n'' all path
          have "nx' influences x in n''" by(fastforce simp:data_dependence_def)
          hence "nx' s-xdd n''" by(rule sum_SDG_ddep_edge)
          with n''  HRB_slice S have "nx'  HRB_slice S"
            by(fastforce elim:combine_SDG_slices.cases 
                       intro:combine_SDG_slices.intros ddep_slice1 ddep_slice2 
                        simp:HRB_slice_def)
          hence "CFG_node (parent_node nx')  HRB_slice S"
            by(rule valid_SDG_node_in_slice_parent_node_in_slice)
          with sourcenode ax'  HRB_slice SCFG ‹parent_node n' = sourcenode ax'
            ‹parent_node nx' = sourcenode ax' show False 
            by(simp add:SDG_to_CFG_set_def)
        qed
      qed
    qed
    with all show ?case by(auto simp add:sourcenodes_def)
  qed
  with ni. valid_SDG_node ni  parent_node ni  set (sourcenodes as'') 
              x  DefSDG ni
  have all:"ni. valid_SDG_node ni  parent_node ni  set (sourcenodes (asx@as'')) 
                  x  DefSDG ni"
    by(auto simp:sourcenodes_def)
  with ‹parent_node n' -asxι* parent_node nx 
    ‹parent_node nx -as''ι* parent_node n''
  have "parent_node n' -asx@as''ι* parent_node n''"
    by(fastforce intro:path_Append simp:intra_path_def)
  from this n''  HRB_slice S x  UseSDG n'' all
  show "x  rv S n'" by(rule rvI)
qed


lemma closed_eq_obs_eq_rvs:
  fixes S :: "'node SDG_node set"
  assumes obs_eq:"obs_intra (parent_node n) HRB_slice SCFG = 
  obs_intra (parent_node n') HRB_slice SCFG"
  shows "rv S n = rv S n'"
proof
  show "rv S n  rv S n'"
  proof
    fix x assume "x  rv S n"
    with obs_eq show "x  rv S n'" by(rule eq_obs_intra_in_rv)
  qed
next
  show "rv S n'  rv S n"
  proof
    fix x assume "x  rv S n'"
    with obs_eq[THEN sym] show "x  rv S n" by(rule eq_obs_intra_in_rv)
  qed
qed



lemma closed_eq_obs_eq_rvs':
  fixes S :: "'node SDG_node set"
  assumes obs_eq:"obs_intra m HRB_slice SCFG = obs_intra m' HRB_slice SCFG"
  shows "rv S (CFG_node m) = rv S (CFG_node m')"
proof
  show "rv S (CFG_node m)  rv S (CFG_node m')"
  proof
    fix x assume "x  rv S (CFG_node m)"
    with obs_eq show "x  rv S (CFG_node m')" 
      by -(rule eq_obs_intra_in_rv,auto)
  qed
next
  show "rv S (CFG_node m')  rv S (CFG_node m)"
  proof
    fix x assume "x  rv S (CFG_node m')"
    with obs_eq[THEN sym] show "x  rv S (CFG_node m)" 
      by -(rule eq_obs_intra_in_rv,auto)
  qed
qed


lemma rv_branching_edges_slice_kinds_False:
  assumes "valid_edge a" and "valid_edge ax" 
  and "sourcenode a = sourcenode ax" and "targetnode a  targetnode ax"
  and "intra_kind (kind a)" and "intra_kind (kind ax)"
  and "preds (slice_kinds S (a#as)) s" 
  and "preds (slice_kinds S (ax#asx)) s'"
  and "length s = length s'" and "snd (hd s) = snd (hd s')"
  and "Vrv S (CFG_node (sourcenode a)). state_val s V = state_val s' V"
  shows False
proof -
  from valid_edge a valid_edge ax sourcenode a = sourcenode ax 
    targetnode a  targetnode ax ‹intra_kind (kind a) ‹intra_kind (kind ax)
  obtain Q Q' where "kind a = (Q)" and "kind ax = (Q')"
    and "s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s)"
    by(auto dest:deterministic)
  from valid_edge a valid_edge ax sourcenode a = sourcenode ax 
    targetnode a  targetnode ax ‹intra_kind (kind a) ‹intra_kind (kind ax)
  obtain P P' where "slice_kind S a = (P)" 
    and "slice_kind S ax = (P')"
    and "s. (P s  ¬ P' s)  (P' s  ¬ P s)"
    by -(erule slice_deterministic,auto)
  show ?thesis
  proof(cases "sourcenode a  HRB_slice SCFG")
    case True
    with ‹intra_kind (kind a)
    have "slice_kind S a = kind a" by -(rule slice_intra_kind_in_slice)
    with ‹preds (slice_kinds S (a#as)) s kind a = (Q) 
      ‹slice_kind S a = (P) have "pred (kind a) s"
      by(simp add:slice_kinds_def)
    from True sourcenode a = sourcenode ax ‹intra_kind (kind ax)
    have "slice_kind S ax = kind ax" 
      by(fastforce intro:slice_intra_kind_in_slice)
    with ‹preds (slice_kinds S (ax#asx)) s' kind ax = (Q')
      ‹slice_kind S ax = (P') have "pred (kind ax) s'" 
      by(simp add:slice_kinds_def)
    with kind ax = (Q') have "Q' (fst (hd s'))" by(cases s') auto
    from valid_edge a have "sourcenode a -[]ι* sourcenode a"
      by(fastforce intro:empty_path simp:intra_path_def)
    with True valid_edge a
    have "V  Use (sourcenode a). V  rv S (CFG_node (sourcenode a))"
      by(auto intro!:rvI CFG_Use_SDG_Use simp:sourcenodes_def SDG_to_CFG_set_def)
    with Vrv S (CFG_node (sourcenode a)). state_val s V = state_val s' V
    have "V  Use (sourcenode a). state_val s V = state_val s' V" by blast
    with valid_edge a ‹pred (kind a) s ‹pred (kind ax) s' ‹length s = length s'
      ‹snd (hd s) = snd (hd s')
    have "pred (kind a) s'" by(auto intro:CFG_edge_Uses_pred_equal)
    with kind a = (Q) have "Q (fst (hd s'))" by(cases s') auto
    with Q' (fst (hd s')) s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s)
    have False by simp
    thus ?thesis by simp
  next
    case False
    with kind a = (Q) ‹slice_kind S a = (P) valid_edge a
    have "P = (λs. False)  P = (λs. True)"
      by(fastforce elim:kind_Predicate_notin_slice_slice_kind_Predicate)
    with ‹slice_kind S a = (P) 
      ‹preds (slice_kinds S (a#as)) s
    have "P = (λs. True)" by(cases s)(auto simp:slice_kinds_def)
    from sourcenode a = sourcenode ax False
    have "sourcenode ax  HRB_slice SCFG" by simp
    with kind ax = (Q') ‹slice_kind S ax = (P') valid_edge ax
    have "P' = (λs. False)  P' = (λs. True)"
      by(fastforce elim:kind_Predicate_notin_slice_slice_kind_Predicate)
    with ‹slice_kind S ax = (P') 
      ‹preds (slice_kinds S (ax#asx)) s'
    have "P' = (λs. True)" by(cases s')(auto simp:slice_kinds_def)
    with P = (λs. True) s. (P s  ¬ P' s)  (P' s  ¬ P s)
    have False by blast
    thus ?thesis by simp
  qed
qed


lemma rv_edge_slice_kinds:
  assumes "valid_edge a" and "intra_kind (kind a)"
  and "Vrv S (CFG_node (sourcenode a)). state_val s V = state_val s' V"
  and "preds (slice_kinds S (a#as)) s" and "preds (slice_kinds S (a#asx)) s'"
  shows "Vrv S (CFG_node (targetnode a)). 
  state_val (transfer (slice_kind S a) s) V = 
  state_val (transfer (slice_kind S a) s') V"
proof
  fix V assume "V  rv S (CFG_node (targetnode a))"
  from ‹preds (slice_kinds S (a#as)) s
  have "s  []" by(cases s,auto simp:slice_kinds_def)
  from ‹preds (slice_kinds S (a#asx)) s'
  have "s'  []" by(cases s',auto simp:slice_kinds_def)
  show "state_val (transfer (slice_kind S a) s) V =
    state_val (transfer (slice_kind S a) s') V"
  proof(cases "V  Def (sourcenode a)")
    case True
    show ?thesis
    proof(cases "sourcenode a  HRB_slice SCFG")
      case True
      with ‹intra_kind (kind a) have "slice_kind S a = kind a"
        by -(rule slice_intra_kind_in_slice)
      with ‹preds (slice_kinds S (a#as)) s have "pred (kind a) s"
        by(simp add:slice_kinds_def)
      from ‹slice_kind S a = kind a 
        ‹preds (slice_kinds S (a#asx)) s'
      have "pred (kind a) s'" by(simp add:slice_kinds_def)
      from valid_edge a have "sourcenode a -[]ι* sourcenode a"
        by(fastforce intro:empty_path simp:intra_path_def)
      with True valid_edge a
      have "V  Use (sourcenode a). V  rv S (CFG_node (sourcenode a))"
        by(auto intro!:rvI CFG_Use_SDG_Use simp:sourcenodes_def SDG_to_CFG_set_def)
      with Vrv S (CFG_node (sourcenode a)). state_val s V = state_val s' V
      have "V  Use (sourcenode a). state_val s V = state_val s' V" by blast
      from valid_edge a this ‹pred (kind a) s ‹pred (kind a) s'
        ‹intra_kind (kind a)
      have "V  Def (sourcenode a). 
        state_val (transfer (kind a) s) V = state_val (transfer (kind a) s') V"
        by -(rule CFG_intra_edge_transfer_uses_only_Use,auto)
      with V  Def (sourcenode a) ‹slice_kind S a = kind a
      show ?thesis by simp
    next
      case False
      from V  rv S (CFG_node (targetnode a)) 
      obtain xs nx where "targetnode a -xsι* parent_node nx"
        and "nx  HRB_slice S" and "V  UseSDG nx"
        and "n''. valid_SDG_node n''  parent_node n''  set (sourcenodes xs) 
           V  DefSDG n''" by(fastforce elim:rvE)
      from valid_edge a have "valid_node (sourcenode a)" by simp
      from valid_edge a targetnode a -xsι* parent_node nx ‹intra_kind (kind a)
      have "sourcenode a -a#xs ι* parent_node nx"
        by(fastforce intro:path.Cons_path simp:intra_path_def)
      with V  Def (sourcenode a) V  UseSDG nx ‹valid_node (sourcenode a)
        n''. valid_SDG_node n''  parent_node n''  set (sourcenodes xs) 
         V  DefSDG n''
      have "(CFG_node (sourcenode a)) influences V in nx"
        by(fastforce intro:CFG_Def_SDG_Def simp:data_dependence_def)
      hence "(CFG_node (sourcenode a)) s-Vdd nx" by(rule sum_SDG_ddep_edge)
      from nx  HRB_slice S (CFG_node (sourcenode a)) s-Vdd nx
      have "CFG_node (sourcenode a)  HRB_slice S"
      proof(induct rule:HRB_slice_cases)
        case (phase1 n nx')
        with (CFG_node (sourcenode a)) s-Vdd nx show ?case
          by(fastforce intro:intro:ddep_slice1 combine_SDG_slices.combSlice_refl 
                       simp:HRB_slice_def)
      next
        case (phase2 nx' n' n'' p n)
        from (CFG_node (sourcenode a)) s-Vdd n n  sum_SDG_slice2 n'
        have "CFG_node (sourcenode a)  sum_SDG_slice2 n'" by(rule ddep_slice2)
        with phase2 show ?thesis
          by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node 
                       simp:HRB_slice_def)
      qed
      with False have False by(simp add:SDG_to_CFG_set_def)
      thus ?thesis by simp
    qed
  next
    case False
    from V  rv S (CFG_node (targetnode a)) 
    obtain xs nx where "targetnode a -xsι* parent_node nx"
      and "nx  HRB_slice S" and "V  UseSDG nx"
      and all:"n''. valid_SDG_node n''  parent_node n''  set (sourcenodes xs) 
                  V  DefSDG n''" by(fastforce elim:rvE)
    from valid_edge a have "valid_node (sourcenode a)" by simp
    from valid_edge a targetnode a -xsι* parent_node nx ‹intra_kind (kind a)
    have "sourcenode a -a#xs ι* parent_node nx"
      by(fastforce intro:path.Cons_path simp:intra_path_def)
    from False all
    have "n''. valid_SDG_node n''  parent_node n''  set (sourcenodes (a#xs)) 
                  V  DefSDG n''"
      by(fastforce dest:SDG_Def_parent_Def simp:sourcenodes_def)
    with sourcenode a -a#xs ι* parent_node nx nx  HRB_slice S
      V  UseSDG nx
    have "V  rv S (CFG_node (sourcenode a))" by(fastforce intro:rvI)
    from ‹intra_kind (kind a) show ?thesis
    proof(cases "kind a")
      case(UpdateEdge f)
      show ?thesis
      proof(cases "sourcenode a  HRB_slice SCFG")
        case True
        with ‹intra_kind (kind a) have "slice_kind S a = kind a"
          by(fastforce intro:slice_intra_kind_in_slice)
        from UpdateEdge s  [] have "pred (kind a) s" by(cases s) auto
        with valid_edge a V  Def (sourcenode a) ‹intra_kind (kind a)
        have "state_val (transfer (kind a) s) V = state_val s V"
          by(fastforce intro:CFG_intra_edge_no_Def_equal)
        from UpdateEdge s'  [] have "pred (kind a) s'" by(cases s') auto
        with valid_edge a V  Def (sourcenode a) ‹intra_kind (kind a)
        have "state_val (transfer (kind a) s') V = state_val s' V"
          by(fastforce intro:CFG_intra_edge_no_Def_equal)
        with Vrv S (CFG_node (sourcenode a)). state_val s V = state_val s' V
          ‹state_val (transfer (kind a) s) V = state_val s V
          V  rv S (CFG_node (sourcenode a)) ‹slice_kind S a = kind a
        show ?thesis by fastforce
      next
        case False
        with UpdateEdge have "slice_kind S a = id" 
          by -(rule slice_kind_Upd)
        with Vrv S (CFG_node (sourcenode a)). state_val s V = state_val s' V
          V  rv S (CFG_node (sourcenode a)) s  [] s'  []
        show ?thesis by(cases s,auto,cases s',auto)
      qed
    next
      case (PredicateEdge Q)
      show ?thesis
      proof(cases "sourcenode a  HRB_slice SCFG")
        case True
        with PredicateEdge ‹intra_kind (kind a) 
        have "slice_kind S a = (Q)"
          by(simp add:slice_intra_kind_in_slice)
        with Vrv S (CFG_node (sourcenode a)). state_val s V = state_val s' V
          V  rv S (CFG_node (sourcenode a)) s  [] s'  []
        show ?thesis by(cases s,auto,cases s',auto)
      next
        case False
        with PredicateEdge valid_edge a 
        obtain Q' where "slice_kind S a = (Q')" 
          by -(erule kind_Predicate_notin_slice_slice_kind_Predicate)
        withVrv S (CFG_node (sourcenode a)). state_val s V = state_val s' V
          V  rv S (CFG_node (sourcenode a)) s  [] s'  []
        show ?thesis by(cases s,auto,cases s',auto)
      qed
    qed (auto simp:intra_kind_def)
  qed
qed



subsection ‹The weak simulation relational set WS›

inductive_set WS :: "'node SDG_node set  (('node list × (('var  'val) × 'ret) list) × 
  ('node list × (('var  'val) × 'ret) list)) set"
for S :: "'node SDG_node set"
  where WSI: "m  set ms. valid_node m; m'  set ms'. valid_node m'; 
  length ms = length s; length ms' = length s'; s  []; s'  []; ms = msx@mx#tl ms';
  get_proc mx = get_proc (hd ms'); 
  m  set (tl ms'). m'. call_of_return_node m m'  m'  HRB_slice SCFG;
  msx  []  (mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG);
  i < length ms'. snd (s!(length msx + i)) = snd (s'!i);
  m  set (tl ms). return_node m;
  i < length ms'. V  rv S (CFG_node ((mx#tl ms')!i)). 
    (fst (s!(length msx + i))) V = (fst (s'!i)) V;
  obs ms HRB_slice SCFG = obs ms' HRB_slice SCFG
   ((ms,s),(ms',s'))  WS S"


lemma WS_silent_move:
  assumes "S,kind  (ms1,s1) -aτ (ms1',s1')" and "((ms1,s1),(ms2,s2))  WS S"
  shows "((ms1',s1'),(ms2,s2))  WS S"
proof -
  from ((ms1,s1),(ms2,s2))  WS S obtain msx mx
    where WSE:"m  set ms1. valid_node m" "m  set ms2. valid_node m"
    "length ms1 = length s1" "length ms2 = length s2" "s1  []" "s2  []" 
    "ms1 = msx@mx#tl ms2" "get_proc mx = get_proc (hd ms2)"
    "m  set (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG"
    "msx  []  (mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG)"
    "m  set (tl ms1). return_node m"
    "i < length ms2. snd (s1!(length msx + i)) = snd (s2!i)"
    "i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
      (fst (s1!(length msx + i))) V = (fst (s2!i)) V"
    "obs ms1 HRB_slice SCFG = obs ms2 HRB_slice SCFG"
    by(fastforce elim:WS.cases)
  { assume "m  set (tl ms1'). return_node m"
    have "obs ms1' HRB_slice SCFG = obs ms2 HRB_slice SCFG"
    proof(cases "obs ms1' HRB_slice SCFG = {}")
      case True
      with S,kind  (ms1,s1) -aτ (ms1',s1') have "obs ms1 HRB_slice SCFG = {}" 
        by(rule silent_move_empty_obs_slice)
      with ‹obs ms1 HRB_slice SCFG = obs ms2 HRB_slice SCFG
        ‹obs ms1' HRB_slice SCFG = {}
      show ?thesis by simp
    next
      case False
      from this m  set (tl ms1'). return_node m
      obtain ms' where "obs ms1' HRB_slice SCFG = {ms'}"
        by(fastforce dest:obs_singleton_element)
      hence "ms'  obs ms1' HRB_slice SCFG" by fastforce
      from S,kind  (ms1,s1) -aτ (ms1',s1') ms'  obs ms1' HRB_slice SCFG 
        m  set (tl ms1'). return_node m
      have "ms'  obs ms1 HRB_slice SCFG" by(fastforce intro:silent_move_obs_slice)
      from this m  set (tl ms1). return_node m
      have "obs ms1 HRB_slice SCFG = {ms'}" by(rule obs_singleton_element)
      with ‹obs ms1' HRB_slice SCFG = {ms'} 
        ‹obs ms1 HRB_slice SCFG = obs ms2 HRB_slice SCFG
      show ?thesis by simp
    qed }
  with S,kind  (ms1,s1) -aτ (ms1',s1') WSE
  show ?thesis
  proof(induct S f"kind" ms1 s1 a ms1' s1' rule:silent_move.induct)
    case (silent_move_intra a s1 s1' ms1 S ms1')
    note obs_eq = aset (tl ms1'). return_node a 
      obs ms1' HRB_slice SCFG = obs ms2 HRB_slice SCFG
    from s1  [] s2  [] obtain cf1 cfs1 cf2 cfs2 where [simp]:"s1 = cf1#cfs1" 
    and [simp]:"s2 = cf2#cfs2" by(cases s1,auto,cases s2,fastforce+)
    from ‹transfer (kind a) s1 = s1' ‹intra_kind (kind a)
    obtain cf1' where [simp]:"s1' = cf1'#cfs1"
      by(cases cf1,cases "kind a",auto simp:intra_kind_def)
    from m  set ms1. valid_node m ms1' = targetnode a # tl ms1 valid_edge a
    have "m  set ms1'. valid_node m" by(cases ms1) auto
    from ‹length ms1 = length s1 ‹length s1' = length s1 
      ms1' = targetnode a # tl ms1
    have "length ms1' = length s1'" by(cases ms1) auto
    from m  set (tl ms1). return_node m ms1' = targetnode a # tl ms1
    have "m  set (tl ms1'). return_node m" by simp
    from obs_eq[OF this] have "obs ms1' HRB_slice SCFG = obs ms2 HRB_slice SCFG" .
    from i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
      (fst (s1!(length msx + i))) V = (fst (s2!i)) V ‹length ms2 = length s2
    have "Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V"
      by(cases ms2) auto
    show ?case
    proof(cases msx)
      case Nil
      with ms1 = msx@mx#tl ms2 ‹hd ms1 = sourcenode a 
      have [simp]:"mx = sourcenode a" and [simp]:"tl ms1 = tl ms2" by simp_all
      from mset (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG
        (mset (tl ms1). m'. call_of_return_node m m'  m'  HRB_slice SCFG) 
        hd ms1  HRB_slice SCFG
      have "hd ms1  HRB_slice SCFG" by fastforce
      with ‹hd ms1 = sourcenode a have "sourcenode a  HRB_slice SCFG" by simp
      from ms1' = targetnode a # tl ms1 have "ms1' = [] @ targetnode a # tl ms2"
        by simp
      from valid_edge a ‹intra_kind(kind a) 
      have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
      with get_proc mx = get_proc (hd ms2) 
      have "get_proc (targetnode a) = get_proc (hd ms2)" by simp
      from ‹transfer (kind a) s1 = s1' ‹intra_kind (kind a)
      have "snd cf1' = snd cf1" by(auto simp:intra_kind_def)
      with i<length ms2. snd (s1 ! (length msx + i)) = snd (s2 ! i) Nil
      have "i<length ms2. snd (s1' ! i) = snd (s2 ! i)"
        by auto(case_tac i,auto)
      have "V  rv S (CFG_node (targetnode a)). fst cf1' V = fst cf2 V"
      proof
        fix V assume "V  rv S (CFG_node (targetnode a))"
        from valid_edge a ‹intra_kind (kind a) sourcenode a  HRB_slice SCFG
        have "obs_intra (targetnode a) HRB_slice SCFG = 
          obs_intra (sourcenode a) HRB_slice SCFG"
          by(rule edge_obs_intra_slice_eq)
        hence "rv S (CFG_node (targetnode a)) = rv S (CFG_node (sourcenode a))" 
          by(rule closed_eq_obs_eq_rvs')
        with V  rv S (CFG_node (targetnode a))
        have "V  rv S (CFG_node (sourcenode a))" by simp
        then obtain as n' where "sourcenode a -asι* parent_node n'" 
          and "n'  HRB_slice S" and "V  UseSDG n'"
          and "n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as) 
                      V  DefSDG n''"
          by(fastforce elim:rvE)
        with sourcenode a  HRB_slice SCFG valid_edge a
        have "V  DefSDG (CFG_node (sourcenode a))"
          apply(clarsimp simp:intra_path_def)
          apply(erule path.cases)
          by(auto dest:valid_SDG_node_in_slice_parent_node_in_slice 
                  simp:sourcenodes_def SDG_to_CFG_set_def)
        from valid_edge a have "valid_node (sourcenode a)" by simp
        with V  DefSDG (CFG_node (sourcenode a)) have "V  Def (sourcenode a)"
          by(fastforce intro:CFG_Def_SDG_Def valid_SDG_CFG_node)
        with valid_edge a ‹intra_kind (kind a) ‹pred (kind a) s1
        have "state_val (transfer (kind a) s1) V = state_val s1 V"
          by(fastforce intro:CFG_intra_edge_no_Def_equal)
        with ‹transfer (kind a) s1 = s1' have "fst cf1' V = fst cf1 V" by simp
        from V  rv S (CFG_node (sourcenode a)) msx = []
          Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V
        have "fst cf1 V = fst cf2 V" by simp
        with ‹fst cf1' V = fst cf1 V show "fst cf1' V = fst cf2 V" by simp
      qed
      with i<length ms2. Vrv S (CFG_node ((mx # tl ms2) ! i)).
        (fst (s1 ! (length msx + i))) V = (fst (s2 ! i)) V Nil
      have "i<length ms2. Vrv S (CFG_node ((targetnode a # tl ms2) ! i)).
        (fst (s1' ! (length [] + i))) V = (fst (s2 ! i)) V"
        by auto (case_tac i,auto)
      with m  set ms1'. valid_node m m  set ms2. valid_node m
        ‹length ms1' = length s1' ‹length ms2 = length s2
        ms1' = [] @ targetnode a # tl ms2 
        get_proc (targetnode a) = get_proc (hd ms2)
        m  set (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG
        m  set (tl ms1). return_node m
        ‹obs ms1' HRB_slice SCFG = obs ms2 HRB_slice SCFG
        i<length ms2. snd (s1' ! i) = snd (s2 ! i)
      show ?thesis by(auto intro!:WSI)
    next
      case (Cons mx' msx')
      with ms1 = msx@mx#tl ms2 ‹hd ms1 = sourcenode a
      have [simp]:"mx' = sourcenode a" and [simp]:"tl ms1 = msx'@mx#tl ms2" 
        by simp_all
     from ms1' = targetnode a # tl ms1 have "ms1' = ((targetnode a)#msx')@mx#tl ms2"
        by simp
      from Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V Cons
      have rv:"Vrv S (CFG_node mx).
        (fst (s1' ! length (targetnode a#msx'))) V = state_val s2 V" by fastforce
      from ms1 = msx@mx#tl ms2 Cons ms1' = targetnode a # tl ms1
      have "ms1' = ((targetnode a)#msx')@mx#tl ms2" by simp
      from i<length ms2. snd (s1 ! (length msx + i)) = snd (s2 ! i) Cons
      have "i<length ms2. snd (s1' ! (length msx + i)) = snd (s2 ! i)" by fastforce 
      from Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V Cons
      have "Vrv S (CFG_node mx). (fst (s1' ! length msx)) V = state_val s2 V"
        by simp
      with i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
        (fst (s1!(length msx + i))) V = (fst (s2!i)) V Cons
      have "i<length ms2. Vrv S (CFG_node ((mx # tl ms2)!i)).
             (fst (s1'!(length (targetnode a # msx') + i))) V = (fst (s2!i)) V"
        by clarsimp
      with mset ms1'. valid_node m mset ms2. valid_node m
        ‹length ms1' = length s1' ‹length ms2 = length s2 
        ms1' = ((targetnode a)#msx')@mx#tl ms2
        mset (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG
        m  set (tl ms1'). return_node m get_proc mx = get_proc (hd ms2)
        msx  []  (mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG)
        ‹obs ms1' HRB_slice SCFG = obs ms2 HRB_slice SCFG Cons
        i<length ms2. snd (s1' ! (length msx + i)) = snd (s2 ! i)
      show ?thesis by -(rule WSI,clarsimp+,fastforce,clarsimp+)
    qed
  next
    case (silent_move_call a s1 s1' Q r p fs a' ms1 S ms1')
    note obs_eq = aset (tl ms1'). return_node a 
      obs ms1' HRB_slice SCFG = obs ms2 HRB_slice SCFG
    from s1  [] s2  [] obtain cf1 cfs1 cf2 cfs2 where [simp]:"s1 = cf1#cfs1" 
      and [simp]:"s2 = cf2#cfs2" by(cases s1,auto,cases s2,fastforce+)
    from valid_edge a kind a = Q:rpfs 
    obtain ins outs where "(p,ins,outs)  set procs"
      by(fastforce dest!:callee_in_procs)
    with ‹transfer (kind a) s1 = s1' valid_edge a kind a = Q:rpfs
    have [simp]:"s1' = (Map.empty(ins [:=] params fs (fst cf1)), r) # cf1 # cfs1"
      by simp(unfold formal_in_THE,simp)
    from ‹length ms1 = length s1 ms1' = targetnode a # targetnode a' # tl ms1
    have "length ms1' = length s1'" by simp
    from valid_edge a a'  get_return_edges a have "valid_edge a'"
      by(rule get_return_edges_valid)
    with mset ms1. valid_node m valid_edge a 
      ms1' = targetnode a # targetnode a' # tl ms1
    have "mset ms1'. valid_node m" by(cases ms1) auto
    from valid_edge a' valid_edge a a'  get_return_edges a
    have "return_node (targetnode a')" by(fastforce simp:return_node_def)
    with valid_edge a a'  get_return_edges a valid_edge a'
    have "call_of_return_node (targetnode a') (sourcenode a)"
      by(simp add:call_of_return_node_def) blast
    from m  set (tl ms1). return_node m ‹return_node (targetnode a')
      ms1' = targetnode a # targetnode a' # tl ms1
    have "m  set (tl ms1'). return_node m" by simp
    from obs_eq[OF this] have "obs ms1' HRB_slice SCFG = obs ms2 HRB_slice SCFG" .
    from i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
      (fst (s1!(length msx + i))) V = (fst (s2!i)) V ‹length ms2 = length s2
    have "Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V"
      by(erule_tac x="0" in allE) auto
    show ?case
    proof(cases msx)
      case Nil
      with ms1 = msx@mx#tl ms2 ‹hd ms1 = sourcenode a 
      have [simp]:"mx = sourcenode a" and [simp]:"tl ms1 = tl ms2" by simp_all
      from mset (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG
        (mset (tl ms1). m'. call_of_return_node m m'  m'  HRB_slice SCFG) 
        hd ms1  HRB_slice SCFG
      have "hd ms1  HRB_slice SCFG" by fastforce
      with ‹hd ms1 = sourcenode a have "sourcenode a  HRB_slice SCFG" by simp
      from valid_edge a a'  get_return_edges a
      obtain a'' where "valid_edge a''" and "sourcenode a'' = sourcenode a"
        and "targetnode a'' = targetnode a'" and "intra_kind(kind a'')"
        by -(drule call_return_node_edge,auto simp:intra_kind_def)
      from valid_edge a'' ‹intra_kind(kind a'')
      have "get_proc (sourcenode a'') = get_proc (targetnode a'')"
        by(rule get_proc_intra)
      with sourcenode a'' = sourcenode a targetnode a'' = targetnode a'
        get_proc mx = get_proc (hd ms2) 
      have "get_proc (targetnode a') = get_proc (hd ms2)" by simp
      from valid_edge a kind a = Q:rpfs a'  get_return_edges a
      have "CFG_node (sourcenode a) s-psum CFG_node (targetnode a')"
        by(fastforce intro:sum_SDG_call_summary_edge)
      have "targetnode a'  HRB_slice SCFG"
      proof
        assume "targetnode a'  HRB_slice SCFG"
        hence "CFG_node (targetnode a')  HRB_slice S" by(simp add:SDG_to_CFG_set_def)
        hence "CFG_node (sourcenode a)  HRB_slice S"
        proof(induct "CFG_node (targetnode a')" rule:HRB_slice_cases)
          case (phase1 nx)
          with ‹CFG_node (sourcenode a) s-psum CFG_node (targetnode a')
          show ?case by(fastforce intro:combine_SDG_slices.combSlice_refl sum_slice1
                                  simp:HRB_slice_def)
        next
          case (phase2 nx n' n'' p')
          from ‹CFG_node (targetnode a')  sum_SDG_slice2 n' 
            ‹CFG_node (sourcenode a) s-psum CFG_node (targetnode a') valid_edge a
          have "CFG_node (sourcenode a)  sum_SDG_slice2 n'"
            by(fastforce intro:sum_slice2)
          with n'  sum_SDG_slice1 nx n'' s-p'ret CFG_node (parent_node n') 
            nx  S
          show ?case
            by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node 
                         simp:HRB_slice_def)
        qed
        with sourcenode a  HRB_slice SCFG show False
          by(simp add:SDG_to_CFG_set_def HRB_slice_def)
      qed
      from ms1' = targetnode a # targetnode a' # tl ms1
      have "ms1' = [targetnode a] @ targetnode a' # tl ms2" by simp
      from i<length ms2. snd (s1 ! (length msx + i)) = snd (s2 ! i) Nil
      have "i<length ms2. snd (s1' ! (length [targetnode a] + i)) = snd (s2 ! i)"
        by fastforce
      have "Vrv S (CFG_node (targetnode a')). (fst (s1' ! 1)) V = state_val s2 V"
      proof
        fix V assume "V  rv S (CFG_node (targetnode a'))"
        from valid_edge a a'  get_return_edges a
        obtain a'' where edge:"valid_edge a''" "sourcenode a'' = sourcenode a"
          "targetnode a'' = targetnode a'" "intra_kind(kind a'')"
          by -(drule call_return_node_edge,auto simp:intra_kind_def)
        from V  rv S (CFG_node (targetnode a'))
        obtain as n' where "targetnode a' -asι* parent_node n'"
          and "n'  HRB_slice S" and "V  UseSDG n'"
          and "n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as) 
           V  DefSDG n''"
          by(fastforce elim:rvE)
        from targetnode a' -asι* parent_node n' edge
        have "sourcenode a -a''#asι* parent_node n'"
          by(fastforce intro:Cons_path simp:intra_path_def)
        from valid_edge a kind a = Q:rpfs
        have "V  Def (sourcenode a)"
          by(fastforce dest:call_source_Def_empty)
        with n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as) 
           V  DefSDG n'' sourcenode a'' = sourcenode a
        have "n''. valid_SDG_node n''  parent_node n''  set (sourcenodes (a''#as)) 
           V  DefSDG n''"
          by(fastforce dest:SDG_Def_parent_Def simp:sourcenodes_def)
        with sourcenode a -a''#asι* parent_node n' n'  HRB_slice S 
          V  UseSDG n'
        have "V  rv S (CFG_node (sourcenode a))" by(fastforce intro:rvI)
        from Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V Nil
        have "Vrv S (CFG_node (sourcenode a)). fst cf1 V = fst cf2 V" by simp
        with V  rv S (CFG_node (sourcenode a)) have "fst cf1 V = fst cf2 V" by simp
        thus "(fst (s1' ! 1)) V = state_val s2 V" by simp
      qed
      with i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
        (fst (s1!(length msx + i))) V = (fst (s2!i)) V Nil
      have "i<length ms2. Vrv S (CFG_node ((targetnode a' # tl ms2)!i)).
        (fst (s1'!(length [targetnode a] + i))) V = (fst (s2!i)) V"
        by clarsimp(case_tac i,auto)
      with mset ms1'. valid_node m mset ms2. valid_node m
        ‹length ms1' = length s1' ‹length ms2 = length s2
        mset (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG
        ms1' = [targetnode a] @ targetnode a' # tl ms2
        targetnode a'  HRB_slice SCFG ‹return_node (targetnode a')
        ‹obs ms1' HRB_slice SCFG = obs ms2 HRB_slice SCFG
        get_proc (targetnode a') = get_proc (hd ms2)
        m  set (tl ms1'). return_node m sourcenode a  HRB_slice SCFG
        ‹call_of_return_node (targetnode a') (sourcenode a)
        i<length ms2. snd (s1' ! (length [targetnode a] + i)) = snd (s2 ! i)
      show ?thesis by(auto intro!:WSI)
    next
      case (Cons mx' msx')
      with ms1 = msx@mx#tl ms2 ‹hd ms1 = sourcenode a
      have [simp]:"mx' = sourcenode a" and [simp]:"tl ms1 = msx'@mx#tl ms2" 
        by simp_all
      from ms1' = targetnode a # targetnode a' # tl ms1 
      have "ms1' = (targetnode a # targetnode a' # msx')@mx#tl ms2"
        by simp
      from i<length ms2. snd (s1 ! (length msx + i)) = snd (s2 ! i) Cons
      have "i<length ms2.
        snd (s1' ! (length (targetnode a # targetnode a' # msx') + i)) = snd (s2 ! i)"
        by fastforce
      from Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V Cons
      have "Vrv S (CFG_node mx). 
        (fst (s1' ! length(targetnode a # targetnode a' # msx'))) V = state_val s2 V" 
        by simp
      with i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
        (fst (s1!(length msx + i))) V = (fst (s2!i)) V Cons
      have "i<length ms2. Vrv S (CFG_node ((mx # tl ms2)!i)).
        (fst (s1'!(length (targetnode a # targetnode a' # msx') + i))) V = 
        (fst (s2!i)) V"
        by clarsimp
      with mset ms1'. valid_node m mset ms2. valid_node m
        ‹length ms1' = length s1' ‹length ms2 = length s2 
        ms1' = (targetnode a # targetnode a' # msx')@mx#tl ms2
        ‹return_node (targetnode a')
        mset (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG
        msx  []  (mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG)
        ‹obs ms1' HRB_slice SCFG = obs ms2 HRB_slice SCFG Cons
        get_proc mx = get_proc (hd ms2) m  set (tl ms1'). return_node m
        i<length ms2.
        snd (s1' ! (length (targetnode a # targetnode a' # msx') + i)) = snd (s2 ! i)
      show ?thesis by -(rule WSI,clarsimp+,fastforce,clarsimp+)
    qed
  next
    case (silent_move_return a s1 s1' Q p f' ms1 S ms1')
    note obs_eq = aset (tl ms1'). return_node a 
      obs ms1' HRB_slice SCFG = obs ms2 HRB_slice SCFG
    from ‹transfer (kind a) s1 = s1' kind a = Qpf' s1  [] s1'  []
    obtain cf1 cfx1 cfs1 cf1' where [simp]:"s1 = cf1#cfx1#cfs1"
      and "s1' = (f' (fst cf1) (fst cfx1),snd cfx1)#cfs1"
      by(cases s1,auto,case_tac list,fastforce+)
    from s2  [] obtain cf2 cfs2 where [simp]:"s2 = cf2#cfs2" by(cases s2) auto
    from ‹length ms1 = length s1 have "ms1  []" and "tl ms1  []" by(cases ms1,auto)+
    from valid_edge a kind a = Qpf'
    obtain a' Q' r' fs' where "valid_edge a'" and "kind a' = Q':r'pfs'"
      and "a  get_return_edges a'"
      by -(drule return_needs_call,auto)
    then obtain ins outs where "(p,ins,outs)  set procs"
      by(fastforce dest!:callee_in_procs)
    with valid_edge a kind a = Qpf'
    have "f' (fst cf1) (fst cfx1) = 
      (fst cfx1)(ParamDefs (targetnode a) [:=] map (fst cf1) outs)"
      by(rule CFG_return_edge_fun)
    with s1' = (f' (fst cf1) (fst cfx1),snd cfx1)#cfs1
    have [simp]:"s1' = ((fst cfx1)
      (ParamDefs (targetnode a) [:=] map (fst cf1) outs),snd cfx1)#cfs1" by simp
    from mset ms1. valid_node m ms1' = tl ms1 have "mset ms1'. valid_node m"
      by(cases ms1) auto
    from ‹length ms1 = length s1 ms1' = tl ms1
    have "length ms1' = length s1'" by simp
    from mset (tl ms1). return_node m ms1' = tl ms1 ms1  [] ‹tl ms1  []
    have "mset (tl ms1'). return_node m" by(cases ms1)(auto,cases ms1',auto)
    from obs_eq[OF this] have "obs ms1' HRB_slice SCFG = obs ms2 HRB_slice SCFG" .
    show ?case
    proof(cases msx)
      case Nil
      with ms1 = msx@mx#tl ms2 ‹hd ms1 = sourcenode a 
      have "mx = sourcenode a" and "tl ms1 = tl ms2" by simp_all
      with mset (tl ms1). m'. call_of_return_node m m'  m'  HRB_slice SCFG
        mset (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      have False by fastforce
      thus ?thesis by simp
    next
      case (Cons mx' msx')
      with ms1 = msx@mx#tl ms2 ‹hd ms1 = sourcenode a
      have [simp]:"mx' = sourcenode a" and [simp]:"tl ms1 = msx'@mx#tl ms2"
        by simp_all
      from ms1' = tl ms1 have "ms1' = msx'@mx#tl ms2" by simp
      with ms1 = msx@mx#tl ms2 mset (tl ms1). return_node m Cons
      have "mset (tl ms1'). return_node m"
        by(cases msx') auto
      from i<length ms2. snd (s1 ! (length msx + i)) = snd (s2 ! i) Cons
      have "i<length ms2. snd (s1' ! (length msx' + i)) = snd (s2 ! i)"
        by auto(case_tac i,auto,cases msx',auto)
      from i<length ms2. Vrv S (CFG_node ((mx # tl ms2) ! i)).
        (fst (s1 ! (length msx + i))) V = (fst (s2 ! i)) V
        ‹length ms2 = length s2 s2  []
      have "Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V"
        by fastforce
      have "Vrv S (CFG_node mx). (fst (s1' ! length msx')) V = state_val s2 V"
      proof(cases msx')
        case Nil
        with Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V
          msx = mx'#msx'
        have rv:"Vrv S (CFG_node mx). fst cfx1 V = fst cf2 V" by fastforce
        from Nil ‹tl ms1 = msx'@mx#tl ms2 ‹hd (tl ms1) = targetnode a
        have [simp]:"mx = targetnode a" by simp
        from Cons 
          msx  []  (mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG)
        obtain mx'' where "call_of_return_node mx mx''" and "mx''  HRB_slice SCFG"
          by blast
        hence "mx  HRB_slice SCFG" 
          by(rule call_node_notin_slice_return_node_neither)
        have "Vrv S (CFG_node mx). 
          (fst cfx1)(ParamDefs (targetnode a) [:=] map (fst cf1) outs) V = fst cf2 V"
        proof
          fix V assume "Vrv S (CFG_node mx)"
          show "(fst cfx1)(ParamDefs (targetnode a) [:=] map (fst cf1) outs) V = 
            fst cf2 V"
          proof(cases "V  set (ParamDefs (targetnode a))")
            case True
            with valid_edge a have "V  Def (targetnode a)"
              by(fastforce intro:ParamDefs_in_Def)
            with valid_edge a have "V  DefSDG (CFG_node (targetnode a))"
              by(auto intro!:CFG_Def_SDG_Def)
            from Vrv S (CFG_node mx) obtain as n' 
              where "targetnode a -asι* parent_node n'"
              and "n'  HRB_slice S" "V  UseSDG n'"
              and "n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as) 
               V  DefSDG n''" by(fastforce elim:rvE)
            from targetnode a -asι* parent_node n' n'  HRB_slice S
              mx  HRB_slice SCFG
            obtain ax asx where "as = ax#asx"
              by(auto simp:intra_path_def)(erule path.cases,
                 auto dest:valid_SDG_node_in_slice_parent_node_in_slice 
                      simp:SDG_to_CFG_set_def)
            with targetnode a -asι* parent_node n' 
            have "targetnode a = sourcenode ax" and "valid_edge ax"
              by(auto elim:path.cases simp:intra_path_def)
            with n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as) 
               V  DefSDG n'' as = ax#asx V  DefSDG (CFG_node (targetnode a))
            have False by(fastforce simp:sourcenodes_def)
            thus ?thesis by simp
          next
            case False
            with Vrv S (CFG_node mx) rv show ?thesis
              by(fastforce dest:fun_upds_notin[of  _ _ "fst cfx1"])
          qed
        qed
        with Nil msx = mx'#msx' show ?thesis by fastforce
      next
        case Cons
        with Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V
          msx = mx'#msx'
        show ?thesis by fastforce
      qed
      with Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V Cons
      have "Vrv S (CFG_node mx). (fst (s1' ! length msx')) V = state_val s2 V"
        by(cases msx') auto
      with i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
        (fst (s1!(length msx + i))) V = (fst (s2!i)) V Cons
      have "i<length ms2. Vrv S (CFG_node ((mx # tl ms2) ! i)).
        (fst (s1' ! (length msx' + i))) V = (fst (s2 ! i)) V"
        by clarsimp(case_tac i,auto)
      with mset ms1'. valid_node m mset ms2. valid_node m
        ‹length ms1' = length s1' ‹length ms2 = length s2 
        ms1' = msx'@mx#tl ms2 get_proc mx = get_proc (hd ms2)
        mset (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG
        msx  []  (mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG)
        mset (tl ms1'). return_node m Cons get_proc mx = get_proc (hd ms2)
        mset (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG
        ‹obs ms1' HRB_slice SCFG = obs ms2 HRB_slice SCFG
        i<length ms2. snd (s1' ! (length msx' + i)) = snd (s2 ! i)
       show ?thesis by(auto intro!:WSI)
    qed
  qed
qed


lemma WS_silent_moves:
  "S,kind  (ms1,s1) =asτ (ms1',s1'); ((ms1,s1),(ms2,s2))  WS S
   ((ms1',s1'),(ms2,s2))  WS S"
by(induct S f"kind" ms1 s1 as ms1' s1' rule:silent_moves.induct,
  auto dest:WS_silent_move)


lemma WS_observable_move:
  assumes "((ms1,s1),(ms2,s2))  WS S"
  and "S,kind  (ms1,s1) -a (ms1',s1')" and "s1'  []"
  obtains as where "((ms1',s1'),(ms1',transfer (slice_kind S a) s2))  WS S"
  and "S,slice_kind S  (ms2,s2) =as@[a] (ms1',transfer (slice_kind S a) s2)"
proof(atomize_elim)
  from ((ms1,s1),(ms2,s2))  WS S obtain msx mx
    where assms:"m  set ms1. valid_node m" "m  set ms2. valid_node m"
    "length ms1 = length s1" "length ms2 = length s2" "s1  []" "s2  []" 
    "ms1 = msx@mx#tl ms2" "get_proc mx = get_proc (hd ms2)" 
    "m  set (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG"
    "msx  []  (mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG)"
    "m  set (tl ms1). return_node m"
    "i < length ms2. snd (s1!(length msx + i)) = snd (s2!i)"
    "i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
      (fst (s1!(length msx + i))) V = (fst (s2!i)) V"
    "obs ms1 HRB_slice SCFG = obs ms2 HRB_slice SCFG"
    by(fastforce elim:WS.cases)
  from S,kind  (ms1,s1) -a (ms1',s1') assms
  show "as. ((ms1',s1'),(ms1',transfer (slice_kind S a) s2))  WS S 
    S,slice_kind S  (ms2,s2) =as @ [a] (ms1',transfer (slice_kind S a) s2)"
  proof(induct S f"kind" ms1 s1 a ms1' s1' rule:observable_move.induct)
    case (observable_move_intra a s1 s1' ms1 S ms1')
    from s1  [] s2  [] obtain cf1 cfs1 cf2 cfs2 where [simp]:"s1 = cf1#cfs1" 
      and [simp]:"s2 = cf2#cfs2" by(cases s1,auto,cases s2,fastforce+)
    from ‹length ms1 = length s1 s1  [] have [simp]:"ms1  []" by(cases ms1) auto
    from ‹length ms2 = length s2 s2  [] have [simp]:"ms2  []" by(cases ms2) auto
    from m  set (tl ms1). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      ‹hd ms1 = sourcenode a ms1 = msx@mx#tl ms2
      msx  []  (mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG)
    have [simp]:"mx = sourcenode a" "msx = []" and [simp]:"tl ms2 = tl ms1"
      by(cases msx,auto)+
    hence "length ms1 = length ms2" by(cases ms2) auto
    with ‹length ms1 = length s1 ‹length ms2 = length s2
    have "length s1 = length s2" by simp
    from ‹hd ms1  HRB_slice SCFG ‹hd ms1 = sourcenode a
    have "sourcenode a  HRB_slice SCFG" by simp
    with valid_edge a
    have "obs_intra (sourcenode a) HRB_slice SCFG = {sourcenode a}"
      by(fastforce intro!:n_in_obs_intra)
    from m  set (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      ‹obs_intra (sourcenode a) HRB_slice SCFG = {sourcenode a} 
      ‹hd ms1 = sourcenode a 
    have "(hd ms1#tl ms1)  obs ([]@hd ms1#tl ms1) HRB_slice SCFG"
      by(cases ms1)(auto intro!:obsI)
    hence "ms1  obs ms1 HRB_slice SCFG" by simp
    with ‹obs ms1 HRB_slice SCFG = obs ms2 HRB_slice SCFG
    have "ms1  obs ms2 HRB_slice SCFG" by simp
    from ms2  [] ‹length ms2 = length s2 have "length s2 = length (hd ms2#tl ms2)"
      by(fastforce dest!:hd_Cons_tl)
    from m  set (tl ms1). return_node m have "m  set (tl ms2). return_node m"
      by simp
    with ms1  obs ms2 HRB_slice SCFG
    have "hd ms1  obs_intra (hd ms2) HRB_slice SCFG"
    proof(rule obsE)
      fix nsx n nsx' n'
      assume "ms2 = nsx @ n # nsx'" and "ms1 = n' # nsx'"
        and "n'  obs_intra n HRB_slice SCFG"
      from ms2 = nsx @ n # nsx' ms1 = n' # nsx' ‹tl ms2 = tl ms1
      have [simp]:"nsx = []" by(cases nsx) auto
      with ms2 = nsx @ n # nsx' have [simp]:"n = hd ms2" by simp
      from ms1 = n' # nsx' have [simp]:"n' = hd ms1" by simp
      with n'  obs_intra n HRB_slice SCFG show ?thesis by simp
    qed
    with ‹length s2 = length (hd ms2#tl ms2) m  set (tl ms2). return_node m
    obtain as where "S,slice_kind S  (hd ms2#tl ms2,s2) =asτ (hd ms1#tl ms1,s2)"
      by(fastforce elim:silent_moves_intra_path_obs[of _ _ _ s2 "tl ms2"])
    with ms2  [] have "S,slice_kind S  (ms2,s2) =asτ (ms1,s2)"
      by(fastforce dest!:hd_Cons_tl)
    from valid_edge a have "valid_node (sourcenode a)" by simp
    hence "sourcenode a -[]ι* sourcenode a"
      by(fastforce intro:empty_path simp:intra_path_def)
    with sourcenode a  HRB_slice SCFG
    have "V. V  UseSDG (CFG_node (sourcenode a)) 
       V  rv S (CFG_node (sourcenode a))"
      by auto(rule rvI,auto simp:SDG_to_CFG_set_def sourcenodes_def)
    with ‹valid_node (sourcenode a)
    have "V  Use (sourcenode a). V  rv S (CFG_node (sourcenode a))"
      by(fastforce intro:CFG_Use_SDG_Use)
    from i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
      (fst (s1!(length msx + i))) V = (fst (s2!i)) V ‹length ms2 = length s2
    have "Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V"
      by(cases ms2) auto
    with V  Use (sourcenode a). V  rv S (CFG_node (sourcenode a))
    have "V  Use (sourcenode a). fst cf1 V = fst cf2 V" by fastforce
    moreover
    from i<length ms2. snd (s1 ! (length msx + i)) = snd (s2 ! i)
    have "snd (hd s1) = snd (hd s2)" by(erule_tac x="0" in allE) auto
    ultimately have "pred (kind a) s2"
      using valid_edge a ‹pred (kind a) s1 ‹length s1 = length s2
      by(fastforce intro:CFG_edge_Uses_pred_equal)
    from ms1' = targetnode a # tl ms1 ‹length s1' = length s1 
      ‹length ms1 = length s1 have "length ms1' = length s1'" by simp
    from ‹transfer (kind a) s1 = s1' ‹intra_kind (kind a)
    obtain cf1' where [simp]:"s1' = cf1'#cfs1"
      by(cases cf1,cases "kind a",auto simp:intra_kind_def)
    from ‹intra_kind (kind a) sourcenode a  HRB_slice SCFG ‹pred (kind a) s2
    have "pred (slice_kind S a) s2" by(simp add:slice_intra_kind_in_slice)
    from valid_edge a ‹length s1 = length s2 ‹transfer (kind a) s1 = s1'
    have "length s1' = length (transfer (slice_kind S a) s2)"
      by(fastforce intro:length_transfer_kind_slice_kind)
    with ‹length s1 = length s2
    have "length s2 = length (transfer (slice_kind S a) s2)" by simp
    with ‹pred (slice_kind S a) s2 valid_edge a ‹intra_kind (kind a)
      m  set (tl ms1). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      ‹hd ms1  HRB_slice SCFG ‹hd ms1 = sourcenode a
      ‹length ms1 = length s1 ‹length s1 = length s2
      ms1' = targetnode a # tl ms1 m  set (tl ms2). return_node m
    have "S,slice_kind S  (ms1,s2) -a (ms1',transfer (slice_kind S a) s2)"
      by(auto intro:observable_move.observable_move_intra)
    with S,slice_kind S  (ms2,s2) =asτ (ms1,s2) 
    have "S,slice_kind S  (ms2,s2) =as@[a] (ms1',transfer (slice_kind S a) s2)"
      by(rule observable_moves_snoc)
    from m  set ms1. valid_node m ms1' = targetnode a # tl ms1 valid_edge a
    have "m  set ms1'. valid_node m" by(cases ms1) auto
    from m  set (tl ms2). return_node m ms1' = targetnode a # tl ms1
      ms1' = targetnode a # tl ms1
    have "m  set (tl ms1'). return_node m" by fastforce
    from ms1' = targetnode a # tl ms1 ‹tl ms2 = tl ms1
    have "ms1' = [] @ targetnode a # tl ms2" by simp
    from ‹intra_kind (kind a) sourcenode a  HRB_slice SCFG
    have cf2':"cf2'. transfer (slice_kind S a) s2 = cf2'#cfs2  snd cf2' = snd cf2"
      by(cases cf2)(auto dest:slice_intra_kind_in_slice simp:intra_kind_def)
    from ‹transfer (kind a) s1 = s1' ‹intra_kind (kind a)
    have "snd cf1' = snd cf1" by(auto simp:intra_kind_def)
    with i<length ms2. snd (s1 ! (length msx + i)) = snd (s2 ! i)
      ‹snd (hd s1) = snd (hd s2) ms1' = [] @ targetnode a # tl ms2
      cf2' ‹length ms1 = length ms2
    have "i<length ms1'. snd (s1' ! i) = snd (transfer (slice_kind S a) s2 ! i)"
      by auto(case_tac i,auto)
    have "V  rv S (CFG_node (targetnode a)). 
      fst cf1' V = state_val (transfer (slice_kind S a) s2) V" 
    proof
      fix V assume "V  rv S (CFG_node (targetnode a))"
      show "fst cf1' V = state_val (transfer (slice_kind S a) s2) V"
      proof(cases "V  Def (sourcenode a)")
        case True
        from ‹intra_kind (kind a) have "(f. kind a = f)  (Q. kind a = (Q))" 
          by(simp add:intra_kind_def)
        thus ?thesis
        proof
          assume "f. kind a = f"
          then obtain f' where "kind a = f'" by blast
          with ‹transfer (kind a) s1 = s1'
          have "s1' = (f' (fst cf1),snd cf1) # cfs1" by simp
          from sourcenode a  HRB_slice SCFG kind a = f'
          have "slice_kind S a = f'"
            by(fastforce dest:slice_intra_kind_in_slice simp:intra_kind_def)
          hence "transfer (slice_kind S a) s2 = (f' (fst cf2),snd cf2) # cfs2" by simp
          from valid_edge a V  Use (sourcenode a). fst cf1 V = fst cf2 V 
            ‹intra_kind (kind a) ‹pred (kind a) s1 ‹pred (kind a) s2
          have "V  Def (sourcenode a). state_val (transfer (kind a) s1) V =
            state_val (transfer (kind a) s2) V"
            by -(erule CFG_intra_edge_transfer_uses_only_Use,auto)
          with kind a = f' s1' = (f' (fst cf1),snd cf1) # cfs1 True
            ‹transfer (slice_kind S a) s2 = (f' (fst cf2),snd cf2) # cfs2
          show ?thesis by simp
        next
          assume "Q. kind a = (Q)"
          then obtain Q where "kind a = (Q)" by blast
          with ‹transfer (kind a) s1 = s1' have "s1' = cf1 # cfs1" by simp
          from sourcenode a  HRB_slice SCFG kind a = (Q)
          have "slice_kind S a = (Q)"
            by(fastforce dest:slice_intra_kind_in_slice simp:intra_kind_def)
          hence "transfer (slice_kind S a) s2 = s2" by simp
          from valid_edge a V  Use (sourcenode a). fst cf1 V = fst cf2 V 
            ‹intra_kind (kind a) ‹pred (kind a) s1 ‹pred (kind a) s2
          have "V  Def (sourcenode a). state_val (transfer (kind a) s1) V =
                                         state_val (transfer (kind a) s2) V"
            by -(erule CFG_intra_edge_transfer_uses_only_Use,auto simp:intra_kind_def)
          with True kind a = (Q) s1' = cf1 # cfs1
            ‹transfer (slice_kind S a) s2 = s2 
          show ?thesis by simp
        qed
      next
        case False
        with valid_edge a ‹intra_kind (kind a) ‹pred (kind a) s1
        have "state_val (transfer (kind a) s1) V = state_val s1 V"
          by(fastforce intro:CFG_intra_edge_no_Def_equal)
        with ‹transfer (kind a) s1 = s1' have "fst cf1' V = fst cf1 V" by simp
        from sourcenode a  HRB_slice SCFG ‹intra_kind (kind a)
        have "slice_kind S a = kind a" by(fastforce intro:slice_intra_kind_in_slice)
        from False valid_edge a ‹pred (kind a) s2 ‹intra_kind (kind a)
        have "state_val (transfer (kind a) s2) V = state_val s2 V"
          by(fastforce intro:CFG_intra_edge_no_Def_equal)
        with ‹slice_kind S a = kind a
        have "state_val (transfer (slice_kind S a) s2) V = fst cf2 V" by simp
        from V  rv S (CFG_node (targetnode a)) obtain as' nx 
          where "targetnode a -as'ι* parent_node nx" 
          and "nx  HRB_slice S" and "V  UseSDG nx"
          and "n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as') 
                      V  DefSDG n''"
          by(fastforce elim:rvE)
        with n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as') 
                     V  DefSDG n'' False
        have all:"n''. valid_SDG_node n''  
          parent_node n''  set (sourcenodes (a#as'))  V  DefSDG n''"
          by(fastforce dest:SDG_Def_parent_Def simp:sourcenodes_def)
        from  valid_edge a targetnode a -as'ι* parent_node nx 
          ‹intra_kind (kind a)
        have "sourcenode a -a#as'ι* parent_node nx"
          by(fastforce intro:Cons_path simp:intra_path_def)
        with nx  HRB_slice S V  UseSDG nx all
        have "V  rv S (CFG_node (sourcenode a))" by(fastforce intro:rvI)
        with V  rv S (CFG_node mx). (fst (s1!(length msx))) V = state_val s2 V
          ‹state_val (transfer (slice_kind S a) s2) V = fst cf2 V
          ‹fst cf1' V = fst cf1 V
        show ?thesis by fastforce
      qed
    qed
    with i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
      (fst (s1!(length msx + i))) V = (fst (s2!i)) V cf2' 
      ms1' = [] @ targetnode a # tl ms2
      ‹length ms1 = length s1 ‹length ms2 = length s2 ‹length s1 = length s2
    have "i<length ms1'. Vrv S (CFG_node ((targetnode a # tl ms1')!i)).
      (fst (s1'!(length [] + i))) V = (fst (transfer (slice_kind S a) s2 ! i)) V"
      by clarsimp(case_tac i,auto)
    with m  set ms2. valid_node m m  set ms1'. valid_node m 
      ‹length ms2 = length s2 ‹length s1' = length (transfer (slice_kind S a) s2)
      ‹length ms1' = length s1' m  set (tl ms1'). return_node m
      ms1' = [] @ targetnode a # tl ms2 get_proc mx = get_proc (hd ms2)
      m  set (tl ms1). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      i<length ms1'. snd (s1' ! i) = snd (transfer (slice_kind S a) s2 ! i)
    have "((ms1',s1'),(ms1',transfer (slice_kind S a) s2))  WS S"
      by(fastforce intro!:WSI)
    with S,slice_kind S  (ms2,s2) =as@[a] (ms1',transfer (slice_kind S a) s2)
    show ?case by blast
  next
    case (observable_move_call a s1 s1' Q r p fs a' ms1 S ms1')
    from s1  [] s2  [] obtain cf1 cfs1 cf2 cfs2 where [simp]:"s1 = cf1#cfs1" 
      and [simp]:"s2 = cf2#cfs2" by(cases s1,auto,cases s2,fastforce+)
    from ‹length ms1 = length s1 s1  [] have [simp]:"ms1  []" by(cases ms1) auto
    from ‹length ms2 = length s2 s2  [] have [simp]:"ms2  []" by(cases ms2) auto
    from m  set (tl ms1). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      ‹hd ms1 = sourcenode a ms1 = msx@mx#tl ms2
      msx  []  (mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG)
    have [simp]:"mx = sourcenode a" "msx = []" and [simp]:"tl ms2 = tl ms1"
      by(cases msx,auto)+
    hence "length ms1 = length ms2" by(cases ms2) auto
    with ‹length ms1 = length s1 ‹length ms2 = length s2
    have "length s1 = length s2" by simp
    from ‹hd ms1  HRB_slice SCFG ‹hd ms1 = sourcenode a
    have "sourcenode a  HRB_slice SCFG" by simp
    with valid_edge a 
    have "obs_intra (sourcenode a) HRB_slice SCFG = {sourcenode a}"
      by(fastforce intro!:n_in_obs_intra)
    from m  set (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      ‹obs_intra (sourcenode a) HRB_slice SCFG = {sourcenode a} 
      ‹hd ms1 = sourcenode a 
    have "(hd ms1#tl ms1)  obs ([]@hd ms1#tl ms1) HRB_slice SCFG"
      by(cases ms1)(auto intro!:obsI)
    hence "ms1  obs ms1 HRB_slice SCFG" by simp
    with ‹obs ms1 HRB_slice SCFG = obs ms2 HRB_slice SCFG
    have "ms1  obs ms2 HRB_slice SCFG" by simp
    from ms2  [] ‹length ms2 = length s2 have "length s2 = length (hd ms2#tl ms2)"
      by(fastforce dest!:hd_Cons_tl)
    from m  set (tl ms1). return_node m have "m  set (tl ms2). return_node m"
      by simp
    with ms1  obs ms2 HRB_slice SCFG
    have "hd ms1  obs_intra (hd ms2) HRB_slice SCFG"
    proof(rule obsE)
      fix nsx n nsx' n'
      assume "ms2 = nsx @ n # nsx'" and "ms1 = n' # nsx'"
        and "n'  obs_intra n HRB_slice SCFG"
      from ms2 = nsx @ n # nsx' ms1 = n' # nsx' ‹tl ms2 = tl ms1
      have [simp]:"nsx = []" by(cases nsx) auto
      with ms2 = nsx @ n # nsx' have [simp]:"n = hd ms2" by simp
      from ms1 = n' # nsx' have [simp]:"n' = hd ms1" by simp
      with n'  obs_intra n HRB_slice SCFG show ?thesis by simp
    qed
    with ‹length s2 = length (hd ms2#tl ms2) m  set (tl ms2). return_node m
    obtain as where "S,slice_kind S  (hd ms2#tl ms2,s2) =asτ (hd ms1#tl ms1,s2)"
      by(fastforce elim:silent_moves_intra_path_obs[of _ _ _ s2 "tl ms2"])
    with ms2  [] have "S,slice_kind S  (ms2,s2) =asτ (ms1,s2)"
      by(fastforce dest!:hd_Cons_tl)
    from valid_edge a have "valid_node (sourcenode a)" by simp
    hence "sourcenode a -[]ι* sourcenode a"
      by(fastforce intro:empty_path simp:intra_path_def)
    with sourcenode a  HRB_slice SCFG
    have "V. V  UseSDG (CFG_node (sourcenode a)) 
       V  rv S (CFG_node (sourcenode a))"
      by auto(rule rvI,auto simp:SDG_to_CFG_set_def sourcenodes_def)
    with ‹valid_node (sourcenode a)
    have "V  Use (sourcenode a). V  rv S (CFG_node (sourcenode a))"
      by(fastforce intro:CFG_Use_SDG_Use)
    from i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
      (fst (s1!(length msx + i))) V = (fst (s2!i)) V ‹length ms2 = length s2
    have "Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V"
      by(cases ms2) auto
    with V  Use (sourcenode a). V  rv S (CFG_node (sourcenode a))
    have "V  Use (sourcenode a). fst cf1 V = fst cf2 V" by fastforce
    moreover
    from i<length ms2. snd (s1 ! (length msx + i)) = snd (s2 ! i)
    have "snd (hd s1) = snd (hd s2)" by(erule_tac x="0" in allE) auto
    ultimately have "pred (kind a) s2"
      using valid_edge a ‹pred (kind a) s1 ‹length s1 = length s2
      by(fastforce intro:CFG_edge_Uses_pred_equal)
    from ms1' = (targetnode a)#(targetnode a')#tl ms1 ‹length s1' = Suc(length s1) 
      ‹length ms1 = length s1 have "length ms1' = length s1'" by simp
    from valid_edge a kind a = Q:rpfs obtain ins outs 
      where "(p,ins,outs)  set procs" by(fastforce dest!:callee_in_procs)
    with valid_edge a kind a = Q:rpfs 
    have "(THE ins. outs. (p,ins,outs)  set procs) = ins"
      by(rule formal_in_THE)
    with ‹transfer (kind a) s1 = s1' kind a = Q:rpfs
    have [simp]:"s1' = (Map.empty(ins [:=] params fs (fst cf1)),r)#cf1#cfs1" by simp
    from valid_edge a' a'  get_return_edges a valid_edge a
    have "return_node (targetnode a')" by(fastforce simp:return_node_def)
    with valid_edge a valid_edge a' a'  get_return_edges a
    have "call_of_return_node (targetnode a') (sourcenode a)"
      by(simp add:call_of_return_node_def) blast
    from sourcenode a  HRB_slice SCFG ‹pred (kind a) s2 kind a = Q:rpfs
    have "pred (slice_kind S a) s2" by(fastforce dest:slice_kind_Call_in_slice)
    from valid_edge a ‹length s1 = length s2 ‹transfer (kind a) s1 = s1'
    have "length s1' = length (transfer (slice_kind S a) s2)"
      by(fastforce intro:length_transfer_kind_slice_kind)
    with ‹pred (slice_kind S a) s2 valid_edge a kind a = Q:rpfs
      m  set (tl ms1). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      ‹hd ms1  HRB_slice SCFG ‹hd ms1 = sourcenode a
      ‹length ms1 = length s1 ‹length s1 = length s2 valid_edge a'
      ms1' = (targetnode a)#(targetnode a')#tl ms1 a'  get_return_edges a
      m  set (tl ms2). return_node m
    have "S,slice_kind S  (ms1,s2) -a (ms1',transfer (slice_kind S a) s2)"
      by(auto intro:observable_move.observable_move_call)
    with S,slice_kind S  (ms2,s2) =asτ (ms1,s2) 
    have "S,slice_kind S  (ms2,s2) =as@[a] (ms1',transfer (slice_kind S a) s2)"
      by(rule observable_moves_snoc)
    from m  set ms1. valid_node m ms1' = (targetnode a)#(targetnode a')#tl ms1
      valid_edge a valid_edge a'
    have "m  set ms1'. valid_node m" by(cases ms1) auto
    from kind a = Q:rpfs sourcenode a  HRB_slice SCFG
    have cf2':"cf2'. transfer (slice_kind S a) s2 = cf2'#s2  snd cf2' = r"
      by(auto dest:slice_kind_Call_in_slice)
    with i<length ms2. snd (s1 ! (length msx + i)) = snd (s2 ! i) 
      ‹length ms1' = length s1' msx = [] ‹length ms1 = length ms2
      ‹length ms1 = length s1
    have "i<length ms1'. snd (s1' ! i) = snd (transfer (slice_kind S a) s2 ! i)"
      by auto(case_tac i,auto)
    have "V  rv S (CFG_node (targetnode a')). 
      V  rv S (CFG_node (sourcenode a))"
    proof
      fix V assume "V  rv S (CFG_node (targetnode a'))"
      then obtain as n' where "targetnode a' -asι* parent_node n'"
        and "n'  HRB_slice S" and "V  UseSDG n'"
        and "n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as) 
         V  DefSDG n''" by(fastforce elim:rvE)
      from valid_edge a a'  get_return_edges a
      obtain a'' where "valid_edge a''" and "sourcenode a'' = sourcenode a"
        and "targetnode a'' = targetnode a'" and "intra_kind(kind a'')"
        by -(drule call_return_node_edge,auto simp:intra_kind_def)
      with targetnode a' -asι* parent_node n' 
      have "sourcenode a -a''#asι* parent_node n'"
        by(fastforce intro:Cons_path simp:intra_path_def)
      from sourcenode a'' = sourcenode a valid_edge a kind a = Q:rpfs
      have "n''. valid_SDG_node n''  parent_node n'' = sourcenode a''
         V  DefSDG n''"
        by(fastforce dest:SDG_Def_parent_Def call_source_Def_empty)
      with n''. valid_SDG_node n''  parent_node n''  set (sourcenodes as) 
         V  DefSDG n''
      have "n''. valid_SDG_node n''  parent_node n''  set (sourcenodes (a''#as)) 
         V  DefSDG n''" by(fastforce simp:sourcenodes_def)
      with sourcenode a -a''#asι* parent_node n' n'  HRB_slice S
        V  UseSDG n'
      show "V  rv S (CFG_node (sourcenode a))" by(fastforce intro:rvI)
    qed
    have "V  rv S (CFG_node (targetnode a)). 
      (Map.empty(ins [:=] params fs (fst cf1))) V = 
      state_val (transfer (slice_kind S a) s2) V"
    proof
      fix V assume "V  rv S (CFG_node (targetnode a))"
      from sourcenode a  HRB_slice SCFG kind a = Q:rpfs
        (THE ins. outs. (p,ins,outs)  set procs) = ins
      have eq:"fst (hd (transfer (slice_kind S a) s2)) = 
        Map.empty(ins [:=] params (cspp (targetnode a) (HRB_slice S) fs) (fst cf2))"
        by(auto dest:slice_kind_Call_in_slice)
      show "(Map.empty(ins [:=] params fs (fst cf1))) V = 
        state_val (transfer (slice_kind S a) s2) V"
      proof(cases "V  set ins")
        case True
        then obtain i where "V = ins!i" and "i < length ins"
          by(auto simp:in_set_conv_nth)
        from valid_edge a kind a = Q:rpfs (p,ins,outs)  set procs
          i < length ins
        have "valid_SDG_node (Formal_in (targetnode a,i))" by fastforce
        from valid_edge a kind a = Q:rpfs have "get_proc(targetnode a) = p"
          by(rule get_proc_call)
        with ‹valid_SDG_node (Formal_in (targetnode a,i)) 
          (p,ins,outs)  set procs V = ins!i
        have "V  DefSDG (Formal_in (targetnode a,i))"
          by(fastforce intro:Formal_in_SDG_Def)
        from V  rv S (CFG_node (targetnode a)) obtain as' nx 
          where "targetnode a -as'ι* parent_node nx" 
          and "nx  HRB_slice S" and "V  UseSDG nx"
          and "n''. valid_SDG_node n''  
          parent_node n''  set (sourcenodes as')  V  DefSDG n''"
          by(fastforce elim:rvE)
        with ‹valid_SDG_node (Formal_in (targetnode a,i))
          V  DefSDG (Formal_in (targetnode a,i))
        have "targetnode a = parent_node nx" 
          apply(auto simp:intra_path_def sourcenodes_def)
          apply(erule path.cases) apply fastforce
          apply(erule_tac x="Formal_in (targetnode a,i)" in allE) by fastforce
        with V  UseSDG nx have "V  Use (targetnode a)"
          by(fastforce intro:SDG_Use_parent_Use)
        with valid_edge a have "V  UseSDG (CFG_node (targetnode a))"
          by(auto intro!:CFG_Use_SDG_Use)
        from targetnode a = parent_node nx[THEN sym] valid_edge a
        have "parent_node (Formal_in (targetnode a,i)) -[]ι* parent_node nx"
          by(fastforce intro:empty_path simp:intra_path_def)
        with V  DefSDG (Formal_in (targetnode a,i)) 
          V  UseSDG (CFG_node (targetnode a)) targetnode a = parent_node nx
        have "Formal_in (targetnode a,i) influences V in (CFG_node (targetnode a))"
          by(fastforce simp:data_dependence_def sourcenodes_def)
        hence ddep:"Formal_in (targetnode a,i) s-Vdd (CFG_node (targetnode a))"
          by(rule sum_SDG_ddep_edge)
        from targetnode a = parent_node nx nx  HRB_slice S
        have "CFG_node (targetnode a)  HRB_slice S"
          by(fastforce dest:valid_SDG_node_in_slice_parent_node_in_slice)
        hence "Formal_in (targetnode a,i)  HRB_slice S"
        proof(induct "CFG_node (targetnode a)" rule:HRB_slice_cases)
          case (phase1 nx)
          with ddep show ?case
            by(fastforce intro:ddep_slice1 combine_SDG_slices.combSlice_refl 
                         simp:HRB_slice_def)
        next
          case (phase2 nx n' n'' p)
          from ‹CFG_node (targetnode a)  sum_SDG_slice2 n' ddep
          have "Formal_in (targetnode a,i)  sum_SDG_slice2 n'"
            by(fastforce intro:ddep_slice2)
          with n'' s-pret CFG_node (parent_node n') n'  sum_SDG_slice1 nx 
            nx  S
          show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node                                  simp:HRB_slice_def)
        qed
        from sourcenode a  HRB_slice SCFG kind a = Q:rpfs
        have slice_kind:"slice_kind S a = 
          Q:rp(cspp (targetnode a) (HRB_slice S) fs)"
          by(rule slice_kind_Call_in_slice)
        from valid_edge a kind a = Q:rpfs (p,ins,outs)  set procs
        have "length fs = length ins" by(rule CFG_call_edge_length)
        from ‹Formal_in (targetnode a,i)  HRB_slice S
          ‹length fs = length ins i < length ins
        have cspp:"(cspp (targetnode a) (HRB_slice S) fs)!i = fs!i"
          by(fastforce intro:csppa_Formal_in_in_slice simp:cspp_def)
        from i < length ins ‹length fs = length ins
        have "(params (cspp (targetnode a) (HRB_slice S) fs) (fst cf2))!i = 
          ((cspp (targetnode a) (HRB_slice S) fs)!i) (fst cf2)"
          by(fastforce intro:params_nth)
        with cspp 
        have eq:"(params (cspp (targetnode a) (HRB_slice S) fs) (fst cf2))!i =
          (fs!i) (fst cf2)" by simp
        from valid_edge a kind a = Q:rpfs (p,ins,outs)  set procs
        have "(THE ins. outs. (p,ins,outs)  set procs) = ins"
          by(rule formal_in_THE)
        with slice_kind
        have "fst (hd (transfer (slice_kind S a) s2)) = 
          Map.empty(ins [:=] params (cspp (targetnode a) (HRB_slice S) fs) (fst cf2))"
          by simp
        moreover
        from (p,ins,outs)  set procs have "distinct ins" 
          by(rule distinct_formal_ins)
        ultimately have "state_val (transfer (slice_kind S a) s2) V = 
          (params (cspp (targetnode a) (HRB_slice S) fs) (fst cf2))!i"
          using V = ins!i i < length ins ‹length fs = length ins
          by(fastforce intro:fun_upds_nth)
        with eq 
        have 2:"state_val (transfer (slice_kind S a) s2) V = (fs!i) (fst cf2)"
          by simp
        from V = ins!i i < length ins ‹length fs = length ins
          ‹distinct ins
        have "Map.empty(ins [:=] params fs (fst cf1)) V = (params fs (fst cf1))!i"
          by(fastforce intro:fun_upds_nth)
        with i < length ins ‹length fs = length ins
        have 1:"Map.empty(ins [:=] params fs (fst cf1)) V = (fs!i) (fst cf1)"
          by(fastforce intro:params_nth)
        from i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
          (fst (s1!(length msx + i))) V = (fst (s2!i)) V
        have rv:"Vrv S (CFG_node (sourcenode a)). fst cf1 V = fst cf2 V"
          by(erule_tac x="0" in allE) auto
        from valid_edge a kind a = Q:rpfs (p,ins,outs)  set procs 
          i < length ins have "V(ParamUses (sourcenode a)!i). 
          V  UseSDG (Actual_in (sourcenode a,i))"
          by(fastforce intro:Actual_in_SDG_Use)
        with valid_edge a have "V(ParamUses (sourcenode a)!i). 
          V  UseSDG (CFG_node (sourcenode a))"
          by(auto intro!:CFG_Use_SDG_Use dest:SDG_Use_parent_Use)
        moreover
        from valid_edge a have "parent_node (CFG_node (sourcenode a)) -[]ι* 
          parent_node (CFG_node (sourcenode a))"
          by(fastforce intro:empty_path simp:intra_path_def)
        ultimately 
        have "V(ParamUses (sourcenode a)!i). V  rv S (CFG_node (sourcenode a))"
          using sourcenode a  HRB_slice SCFG valid_edge a
          by(fastforce intro:rvI simp:SDG_to_CFG_set_def sourcenodes_def)
        with rv have "V  (ParamUses (sourcenode a))!i. fst cf1 V = fst cf2 V"
          by fastforce
        with valid_edge a kind a = Q:rpfs i < length ins
          (p,ins,outs)  set procs ‹pred (kind a) s1 ‹pred (kind a) s2
        have "(params fs (fst cf1))!i = (params fs (fst cf2))!i"
          by(fastforce dest!:CFG_call_edge_params)
        moreover
        from i < length ins ‹length fs = length ins
        have "(params fs (fst cf1))!i = (fs!i) (fst cf1)" 
          and "(params fs (fst cf2))!i = (fs!i) (fst cf2)"
          by(auto intro:params_nth)
        ultimately show ?thesis using 1 2 by simp
      next
        case False
        with eq show ?thesis by(fastforce simp:fun_upds_notin)
      qed
    qed
    with i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
      (fst (s1!(length msx + i))) V = (fst (s2!i)) V cf2' ‹tl ms2 = tl ms1
      ‹length ms2 = length s2 ‹length ms1 = length s1 ‹length s1 = length s2
      ms1' = (targetnode a)#(targetnode a')#tl ms1
      V  rv S (CFG_node (targetnode a')). V  rv S (CFG_node (sourcenode a))
    have "i<length ms1'. Vrv S (CFG_node ((targetnode a # tl ms1')!i)).
      (fst (s1'!(length [] + i))) V = (fst (transfer (slice_kind S a) s2!i)) V"
      apply clarsimp apply(case_tac i) apply auto
      apply(erule_tac x="nat" in allE)
      apply(case_tac nat) apply auto done
    with m  set ms2. valid_node m m  set ms1'. valid_node m 
      ‹length ms2 = length s2 ‹length s1' = length (transfer (slice_kind S a) s2)
      ‹length ms1' = length s1' ms1' = (targetnode a)#(targetnode a')#tl ms1
      get_proc mx = get_proc (hd ms2) sourcenode a  HRB_slice SCFG
      m  set (tl ms1). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      ‹return_node (targetnode a') m  set (tl ms1). return_node m
      ‹call_of_return_node (targetnode a') (sourcenode a)
      i<length ms1'. snd (s1' ! i) = snd (transfer (slice_kind S a) s2 ! i)
    have "((ms1',s1'),(ms1',transfer (slice_kind S a) s2))  WS S"
      by(fastforce intro!:WSI)
    with S,slice_kind S  (ms2,s2) =as@[a] (ms1',transfer (slice_kind S a) s2)
    show ?case by blast
  next
    case (observable_move_return a s1 s1' Q p f' ms1 S ms1')
    from s1  [] s2  [] obtain cf1 cfs1 cf2 cfs2 where [simp]:"s1 = cf1#cfs1" 
      and [simp]:"s2 = cf2#cfs2" by(cases s1,auto,cases s2,fastforce+)
    from ‹length ms1 = length s1 s1  [] have [simp]:"ms1  []" by(cases ms1) auto
    from ‹length ms2 = length s2 s2  [] have [simp]:"ms2  []" by(cases ms2) auto
    from m  set (tl ms1). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      ‹hd ms1 = sourcenode a ms1 = msx@mx#tl ms2
      msx  []  (mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG)
    have [simp]:"mx = sourcenode a" "msx = []" and [simp]:"tl ms2 = tl ms1"
      by(cases msx,auto)+
    hence "length ms1 = length ms2" by(cases ms2) auto
    with ‹length ms1 = length s1 ‹length ms2 = length s2
    have "length s1 = length s2" by simp
    have "as. S,slice_kind S  (ms2,s2) =asτ (ms1,s2)"
    proof(cases "obs_intra (hd ms2) HRB_slice SCFG = {}")
      case True
      from valid_edge a ‹hd ms1 = sourcenode a kind a = Qpf'
      have "method_exit (hd ms1)" by(fastforce simp:method_exit_def)
      from mset ms2. valid_node m have "valid_node (hd ms2)" by(cases ms2) auto
      then obtain asx where "hd ms2 -asx* (_Exit_)" by(fastforce dest!:Exit_path)
      then obtain as pex where "hd ms2 -asι* pex" and "method_exit pex"
        by(fastforce elim:valid_Exit_path_intra_path)
      from ‹hd ms2 -asι* pex have "get_proc (hd ms2) = get_proc pex"
        by(rule intra_path_get_procs)
      with get_proc mx = get_proc (hd ms2)
      have "get_proc mx = get_proc pex" by simp
      with ‹method_exit (hd ms1) ‹ hd ms1 = sourcenode a ‹method_exit pex
      have [simp]:"pex = hd ms1" by(fastforce intro:method_exit_unique)
      from ‹obs_intra (hd ms2) HRB_slice SCFG = {} ‹method_exit pex
        get_proc (hd ms2) = get_proc pex ‹valid_node (hd ms2)
        ‹length ms2 = length s2 mset (tl ms1). return_node m ms2  []
      obtain as' 
        where "S,slice_kind S  (hd ms2#tl ms2,s2) =as'τ (hd ms1#tl ms1,s2)"
        by(fastforce elim!:silent_moves_intra_path_no_obs[of _ _ _ s2 "tl ms2"]
                     dest:hd_Cons_tl)
      with ms2  [] have "S,slice_kind S  (ms2,s2) =as'τ (ms1,s2)"
        by(fastforce dest!:hd_Cons_tl)
      thus ?thesis by blast
    next
      case False
      then obtain x where "x  obs_intra (hd ms2) HRB_slice SCFG" by fastforce
      hence "obs_intra (hd ms2) HRB_slice SCFG = {x}"
        by(rule obs_intra_singleton_element)
      with m  set (tl ms2). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      have "x#tl ms1  obs ([]@hd ms2#tl ms2) HRB_slice SCFG"
        by(fastforce intro:obsI)
      with ms2  [] have "x#tl ms1  obs ms2 HRB_slice SCFG"
        by(fastforce dest:hd_Cons_tl simp del:obs.simps)
      with ‹obs ms1 HRB_slice SCFG = obs ms2 HRB_slice SCFG
      have "x#tl ms1  obs ms1 HRB_slice SCFG" by simp
      from this mset (tl ms1). return_node m
      have "x  obs_intra (hd ms1) HRB_slice SCFG"
      proof(rule obsE)
        fix nsx n nsx' n'
        assume "ms1 = nsx @ n # nsx'" and "x # tl ms1 = n' # nsx'"
          and "n'  obs_intra n HRB_slice SCFG"
        from ms1 = nsx @ n # nsx' x # tl ms1 = n' # nsx' ‹tl ms2 = tl ms1
        have [simp]:"nsx = []" by(cases nsx) auto
        with ms1 = nsx @ n # nsx' have [simp]:"n = hd ms1" by simp
        from x # tl ms1 = n' # nsx' have [simp]:"n' = x" by simp
        with n'  obs_intra n HRB_slice SCFG show ?thesis by simp
      qed
      { fix m as assume "hd ms1 -asι* m"
        hence "hd ms1 -as→* m" and "a  set as. intra_kind (kind a)"
          by(simp_all add:intra_path_def)
        hence "m = hd ms1"
        proof(induct "hd ms1" as m rule:path.induct)
          case (Cons_path m'' as' m' a')
          from aset (a' # as'). intra_kind (kind a)
          have "intra_kind (kind a')" by simp
          with valid_edge a kind a = Qpf' valid_edge a' 
            sourcenode a' = hd ms1 ‹hd ms1 = sourcenode a
          have False by(fastforce dest:return_edges_only simp:intra_kind_def)
          thus ?case by simp
        qed simp }
      with x  obs_intra (hd ms1) HRB_slice SCFG
      have "x = hd ms1" by(fastforce elim:obs_intraE)
      with x  obs_intra (hd ms2) HRB_slice SCFG ‹length ms2 = length s2 
        mset (tl ms1). return_node m ms2  []
      obtain as where "S,slice_kind S  (hd ms2#tl ms2,s2) =asτ (hd ms1#tl ms1,s2)"
        by(fastforce elim!:silent_moves_intra_path_obs[of _ _ _ s2 "tl ms2"] 
                     dest:hd_Cons_tl)
      with ms2  [] have "S,slice_kind S  (ms2,s2) =asτ (ms1,s2)"
        by(fastforce dest!:hd_Cons_tl)
      thus ?thesis by blast
    qed
    then obtain as where "S,slice_kind S  (ms2,s2) =asτ (ms1,s2)" by blast
    from ms1' = tl ms1 ‹length s1 = Suc(length s1') 
      ‹length ms1 = length s1 have "length ms1' = length s1'" by simp
    from valid_edge a kind a = Qpf' obtain a'' Q' r' fs' where "valid_edge a''"
      and "kind a'' = Q':r'pfs'" and "a  get_return_edges a''"
      by -(drule return_needs_call,auto)
    then obtain ins outs where "(p,ins,outs)  set procs"
      by(fastforce dest!:callee_in_procs)
    from ‹length s1 = Suc(length s1') s1'  []
    obtain cfx cfsx where [simp]:"cfs1 = cfx#cfsx" by(cases cfs1) auto
    with ‹length s1 = length s2 obtain cfx' cfsx' where [simp]:"cfs2 = cfx'#cfsx'"
      by(cases cfs2) auto
    from ‹length ms1 = length s1 have "tl ms1 = []@hd(tl ms1)#tl(tl ms1)"
      by(auto simp:length_Suc_conv)
    from kind a = Qpf' ‹transfer (kind a) s1 = s1'
    have "s1' = (f' (fst cf1) (fst cfx),snd cfx)#cfsx" by simp
    from valid_edge a kind a = Qpf' (p,ins,outs)  set procs
    have "f' (fst cf1) (fst cfx) = 
      (fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf1) outs)"
      by(rule CFG_return_edge_fun)
    with s1' = (f' (fst cf1) (fst cfx),snd cfx)#cfsx
    have [simp]:"s1' = 
      ((fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf1) outs),snd cfx)#cfsx"
      by simp
    have "pred (slice_kind S a) s2"
    proof(cases "sourcenode a  HRB_slice SCFG")
      case True
      from valid_edge a have "valid_node (sourcenode a)" by simp
      hence "sourcenode a -[]ι* sourcenode a"
        by(fastforce intro:empty_path simp:intra_path_def)
      with sourcenode a  HRB_slice SCFG
      have "V. V  UseSDG (CFG_node (sourcenode a)) 
         V  rv S (CFG_node (sourcenode a))"
        by auto(rule rvI,auto simp:SDG_to_CFG_set_def sourcenodes_def)
      with ‹valid_node (sourcenode a)
      have "V  Use (sourcenode a). V  rv S (CFG_node (sourcenode a))"
        by(fastforce intro:CFG_Use_SDG_Use)
      from i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
        (fst (s1!(length msx + i))) V = (fst (s2!i)) V ‹length ms2 = length s2
      have "Vrv S (CFG_node mx). (fst (s1 ! length msx)) V = state_val s2 V"
        by(cases ms2) auto
      with V  Use (sourcenode a). V  rv S (CFG_node (sourcenode a))
      have "V  Use (sourcenode a). fst cf1 V = fst cf2 V" by fastforce
      moreover
      from i<length ms2. snd (s1 ! (length msx + i)) = snd (s2 ! i)
      have "snd (hd s1) = snd (hd s2)" by(erule_tac x="0" in allE) auto
      ultimately have "pred (kind a) s2"
        using valid_edge a ‹pred (kind a) s1 ‹length s1 = length s2
        by(fastforce intro:CFG_edge_Uses_pred_equal)
      with valid_edge a kind a = Qpf' (p,ins,outs)  set procs 
        sourcenode a  HRB_slice SCFG
      show ?thesis by(fastforce dest:slice_kind_Return_in_slice)
    next
      case False
      with kind a = Qpf' have "slice_kind S a = (λcf. True)p(λcf cf'. cf')"
        by -(rule slice_kind_Return)
      thus ?thesis by simp
    qed
    from valid_edge a ‹length s1 = length s2 ‹transfer (kind a) s1 = s1'
    have "length s1' = length (transfer (slice_kind S a) s2)"
      by(fastforce intro:length_transfer_kind_slice_kind)
    with ‹pred (slice_kind S a) s2 valid_edge a kind a = Qpf'
      m  set (tl ms1). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      ‹hd ms1 = sourcenode a
      ‹length ms1 = length s1 ‹length s1 = length s2
      ms1' = tl ms1 ‹hd(tl ms1) = targetnode a m  set (tl ms1). return_node m
    have "S,slice_kind S  (ms1,s2) -a (ms1',transfer (slice_kind S a) s2)"
      by(fastforce intro!:observable_move.observable_move_return)
    with S,slice_kind S  (ms2,s2) =asτ (ms1,s2)
    have "S,slice_kind S  (ms2,s2) =as@[a] (ms1',transfer (slice_kind S a) s2)"
      by(rule observable_moves_snoc)
    from m  set ms1. valid_node m ms1' = tl ms1
    have "m  set ms1'. valid_node m" by(cases ms1) auto
    from ‹length ms1' = length s1' have "ms1' = []@hd ms1'#tl ms1'"
      by(cases ms1') auto
    from i<length ms2. snd (s1 ! (length msx + i)) = snd (s2 ! i)
      ‹length ms1 = length ms2 ‹length ms1 = length s1
    have "snd cfx = snd cfx'" by(erule_tac x="1" in allE) auto
    from valid_edge a kind a = Qpf' (p,ins,outs)  set procs
    have cf2':"cf2'. transfer (slice_kind S a) s2 = cf2'#cfsx'  snd cf2' = snd cfx'"
      by(cases cfx',cases "sourcenode a  HRB_slice SCFG",
         auto dest:slice_kind_Return slice_kind_Return_in_slice)
    with i<length ms2. snd (s1 ! (length msx + i)) = snd (s2 ! i) 
      ‹length ms1' = length s1' msx = [] ‹length ms1 = length ms2
      ‹length ms1 = length s1 ‹snd cfx = snd cfx'
    have "i<length ms1'. snd (s1' ! i) = snd (transfer (slice_kind S a) s2 ! i)"
      apply auto apply(case_tac i) apply auto
      by(erule_tac x="Suc(Suc nat)" in allE) auto
    from m  set (tl ms1). m'. call_of_return_node m m'  m'  HRB_slice SCFG
    have "m  set (tl (tl ms1)). 
      m'. call_of_return_node m m'  m'  HRB_slice SCFG"
      by(cases "tl ms1") auto
    from m  set (tl ms1). return_node m
    have "m  set (tl (tl ms1)). return_node m" by(cases "tl ms1") auto
    have "Vrv S (CFG_node (hd (tl ms1))).
      (fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf1) outs) V = 
      state_val (transfer (slice_kind S a) s2) V"
    proof
      fix V assume "Vrv S (CFG_node (hd (tl ms1)))"
      with ‹hd(tl ms1) = targetnode a have "Vrv S (CFG_node (targetnode a))"
        by simp
      show "(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf1) outs) V = 
        state_val (transfer (slice_kind S a) s2) V"
      proof(cases "V  set (ParamDefs (targetnode a))")
        case True
        then obtain i where "V = (ParamDefs (targetnode a))!i" 
          and "i < length(ParamDefs (targetnode a))"
          by(auto simp:in_set_conv_nth)
        moreover
        from valid_edge a kind a = Qpf' (p,ins,outs)  set procs
        have length:"length(ParamDefs (targetnode a)) = length outs"
          by(fastforce intro:ParamDefs_return_target_length)
        from valid_edge a kind a = Qpf' (p,ins,outs)  set procs
          i < length(ParamDefs (targetnode a)) 
          ‹length(ParamDefs (targetnode a)) = length outs
        have "valid_SDG_node (Actual_out(targetnode a,i))" by fastforce
        with V = (ParamDefs (targetnode a))!i
        have "V  DefSDG (Actual_out(targetnode a,i))"
          by(fastforce intro:Actual_out_SDG_Def)
        from V  rv S (CFG_node (targetnode a)) obtain as' nx 
          where "targetnode a -as'ι* parent_node nx" 
          and "nx  HRB_slice S" and "V  UseSDG nx"
          and "n''. valid_SDG_node n''  
                         parent_node n''  set (sourcenodes as')  V  DefSDG n''"
          by(fastforce elim:rvE)
        with ‹valid_SDG_node (Actual_out(targetnode a,i))
          V  DefSDG (Actual_out(targetnode a,i))
        have "targetnode a = parent_node nx" 
          apply(auto simp:intra_path_def sourcenodes_def)
          apply(erule path.cases) apply fastforce
          apply(erule_tac x="(Actual_out(targetnode a,i))" in allE) by fastforce
        with V  UseSDG nx have "V  Use (targetnode a)"
          by(fastforce intro:SDG_Use_parent_Use)
        with valid_edge a have "V  UseSDG (CFG_node (targetnode a))"
          by(auto intro!:CFG_Use_SDG_Use)
        from targetnode a = parent_node nx[THEN sym] valid_edge a
        have "parent_node (Actual_out(targetnode a,i)) -[]ι* parent_node nx"
          by(fastforce intro:empty_path simp:intra_path_def)
        with V  DefSDG (Actual_out(targetnode a,i)) 
          V  UseSDG (CFG_node (targetnode a)) targetnode a = parent_node nx
        have "Actual_out(targetnode a,i) influences V in (CFG_node (targetnode a))"
          by(fastforce simp:data_dependence_def sourcenodes_def)
        hence ddep:"Actual_out(targetnode a,i) s-Vdd (CFG_node (targetnode a))"
          by(rule sum_SDG_ddep_edge)
        from targetnode a = parent_node nx nx  HRB_slice S
        have "CFG_node (targetnode a)  HRB_slice S"
          by(fastforce dest:valid_SDG_node_in_slice_parent_node_in_slice)
        hence "Actual_out(targetnode a,i)  HRB_slice S"
        proof(induct "CFG_node (targetnode a)" rule:HRB_slice_cases)
          case (phase1 nx')
          with ddep show ?case
            by(fastforce intro: ddep_slice1 combine_SDG_slices.combSlice_refl
                         simp:HRB_slice_def)
        next
          case (phase2 nx' n' n'' p)
          from ‹CFG_node (targetnode a)  sum_SDG_slice2 n' ddep
          have "Actual_out(targetnode a,i)  sum_SDG_slice2 n'"
            by(fastforce intro:ddep_slice2)
          with n'' s-pret CFG_node (parent_node n') n'  sum_SDG_slice1 nx'
            nx'  S
          show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
                                  simp:HRB_slice_def)
        qed
        from valid_edge a kind a = Qpf' valid_edge a''
          kind a'' = Q':r'pfs' a  get_return_edges a''
          ‹CFG_node (targetnode a)  HRB_slice S
        have "CFG_node (sourcenode a)  HRB_slice S"
          by(rule call_return_nodes_in_slice)
        hence "sourcenode a  HRB_slice SCFG" by(simp add:SDG_to_CFG_set_def)
        from sourcenode a  HRB_slice SCFG valid_edge a kind a = Qpf'
          (p,ins,outs)  set procs
        have slice_kind:"slice_kind S a = 
          Qp(λcf cf'. rspp (targetnode a) (HRB_slice S) outs cf' cf)"
          by(rule slice_kind_Return_in_slice)
        from ‹Actual_out(targetnode a,i)  HRB_slice S
          i < length(ParamDefs (targetnode a)) valid_edge a
          V = (ParamDefs (targetnode a))!i length
        have 2:"rspp (targetnode a) (HRB_slice S) outs (fst cfx') (fst cf2) V = 
          (fst cf2)(outs!i)"
          by(fastforce intro:rspp_Actual_out_in_slice)
        from i < length(ParamDefs (targetnode a)) length valid_edge a
        have "(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf1) outs) 
          ((ParamDefs (targetnode a))!i) = (map (fst cf1) outs)!i"
          by(fastforce intro:fun_upds_nth distinct_ParamDefs)
        with V = (ParamDefs (targetnode a))!i 
          i < length(ParamDefs (targetnode a)) length
        have 1:"(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf1) outs) V = 
          (fst cf1)(outs!i)" 
          by simp
        from valid_edge a kind a = Qpf' (p,ins,outs)  set procs 
          i < length(ParamDefs (targetnode a)) length
        have po:"Formal_out(sourcenode a,i) s-p:outs!iout Actual_out(targetnode a,i)"
          by(fastforce intro:sum_SDG_param_out_edge)
        from valid_edge a kind a = Qpf'
        have "CFG_node (sourcenode a) s-pret CFG_node (targetnode a)"
          by(fastforce intro:sum_SDG_return_edge)
        from ‹Actual_out(targetnode a,i)  HRB_slice S
        have "Formal_out(sourcenode a,i)  HRB_slice S"
        proof(induct "Actual_out(targetnode a,i)" rule:HRB_slice_cases)
          case (phase1 nx')
          let ?AO = "Actual_out(targetnode a,i)"
          from ‹valid_SDG_node ?AO have "?AO  sum_SDG_slice2 ?AO"
            by(rule refl_slice2)
          with po have "Formal_out(sourcenode a,i)  sum_SDG_slice2 ?AO"
            by(rule param_out_slice2)
          with ‹CFG_node (sourcenode a) s-pret CFG_node (targetnode a)
            ‹Actual_out (targetnode a, i)  sum_SDG_slice1 nx' nx'  S
          show ?case
            by(fastforce intro:combSlice_Return_parent_node simp:HRB_slice_def)
        next
          case (phase2 nx' n' n'' p)
          from ‹Actual_out (targetnode a, i)  sum_SDG_slice2 n' po
          have "Formal_out(sourcenode a,i)  sum_SDG_slice2 n'"
            by(fastforce intro:param_out_slice2)
          with n'  sum_SDG_slice1 nx' n'' s-pret CFG_node (parent_node n') 
            nx'  S
          show ?case by(fastforce intro:combine_SDG_slices.combSlice_Return_parent_node
                                  simp:HRB_slice_def)
        qed
        with valid_edge a kind a = Qpf' (p,ins,outs)  set procs 
          i < length(ParamDefs (targetnode a)) length
        have "outs!i  UseSDG Formal_out(sourcenode a,i)"
          by(fastforce intro!:Formal_out_SDG_Use get_proc_return)
        with valid_edge a have "outs!i  UseSDG (CFG_node (sourcenode a))"
          by(auto intro!:CFG_Use_SDG_Use dest:SDG_Use_parent_Use)
        moreover
        from valid_edge a have "parent_node (CFG_node (sourcenode a)) -[]ι* 
          parent_node (CFG_node (sourcenode a))"
          by(fastforce intro:empty_path simp:intra_path_def)
        ultimately have "outs!i  rv S (CFG_node (sourcenode a))"
          using sourcenode a  HRB_slice SCFG valid_edge a
          by(fastforce intro:rvI simp:SDG_to_CFG_set_def sourcenodes_def)
        with i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
          (fst (s1!(length msx + i))) V = (fst (s2!i)) V
        have "(fst cf1)(outs!i) = (fst cf2)(outs!i)"
          by auto(erule_tac x="0" in allE,auto)
        with 1 2 slice_kind show ?thesis by simp
      next
        case False
        with ‹transfer (kind a) s1 = s1'
        have "(fst cfx)(ParamDefs (targetnode a) [:=] map (fst cf1) outs) =
          (fst (hd cfs1))(ParamDefs (targetnode a) [:=] map (fst cf1) outs)"
          by(cases cfs1,auto intro:CFG_return_edge_fun)
        show ?thesis
        proof(cases "sourcenode a  HRB_slice SCFG")
          case True
          from sourcenode a  HRB_slice SCFG valid_edge a kind a = Qpf'
            (p,ins,outs)  set procs
          have "slice_kind S a = 
            Qp(λcf cf'. rspp (targetnode a) (HRB_slice S) outs cf' cf)"
            by(rule slice_kind_Return_in_slice)
          with ‹length s1' = length (transfer (slice_kind S a) s2) 
            ‹length s1 = length s2
          have "state_val (transfer (slice_kind S a) s2) V = 
            rspp (targetnode a) (HRB_slice S) outs (fst cfx') (fst cf2) V"
            by simp
          with V  set (ParamDefs (targetnode a))
          have "state_val (transfer (slice_kind S a) s2) V = state_val cfs2 V"
            by(fastforce simp:rspp_def map_merge_def)
          with i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
            (fst (s1!(length msx + i))) V = (fst (s2!i)) V
            ‹hd(tl ms1) = targetnode a
            ‹length ms1 = length s1 ‹length s1 = length s2[THEN sym] False
            ‹tl ms2 = tl ms1 ‹length ms2 = length s2
            Vrv S (CFG_node (targetnode a))
          show ?thesis by(fastforce simp:length_Suc_conv fun_upds_notin)
        next
          case False
          from sourcenode a  HRB_slice SCFG kind a = Qpf'
          have "slice_kind S a = (λcf. True)p(λcf cf'. cf')"
            by(rule slice_kind_Return)
          from ‹length ms2 = length s2 have "1 < length ms2" by simp
          with i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
            (fst (s1!(length msx + i))) V = (fst (s2!i)) V
            Vrv S (CFG_node (hd (tl ms1)))
            ms1' = tl ms1 ms1' = []@hd ms1'#tl ms1'
          have "fst cfx V = fst cfx' V" apply auto
            apply(erule_tac x="1" in allE)
            by(cases "tl ms1") auto
          with i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
            (fst (s1!(length msx + i))) V = (fst (s2!i)) V 
            ‹hd(tl ms1) = targetnode a
            ‹length ms1 = length s1 ‹length s1 = length s2[THEN sym] False
            ‹tl ms2 = tl ms1 ‹length ms2 = length s2
            Vrv S (CFG_node (targetnode a))
            V  set (ParamDefs (targetnode a))
            ‹slice_kind S a = (λcf. True)p(λcf cf'. cf')
          show ?thesis by(auto simp:fun_upds_notin)
        qed
      qed
    qed
    with ‹hd(tl ms1) = targetnode a ‹tl ms2 = tl ms1 ms1' = tl ms1
      i < length ms2. V  rv S (CFG_node ((mx#tl ms2)!i)). 
        (fst (s1!(length msx + i))) V = (fst (s2!i)) V ‹length ms1' = length s1'
      ‹length ms1 = length s1 ‹length ms2 = length s2 ‹length s1 = length s2 cf2'
    have "i<length ms1'. Vrv S (CFG_node ((hd (tl ms1) # tl ms1')!i)).
      (fst (s1'!(length [] + i))) V = (fst (transfer (slice_kind S a) s2!i)) V"
      apply(case_tac "tl ms1") apply auto 
      apply(cases ms2) apply auto
      apply(case_tac i) apply auto
      by(erule_tac x="Suc(Suc nat)" in allE,auto)
    with m  set ms2. valid_node m m  set ms1'. valid_node m 
      ‹length ms2 = length s2 ‹length s1' = length (transfer (slice_kind S a) s2)
      ‹length ms1' = length s1' ms1' = tl ms1 ms1' = []@hd ms1'#tl ms1'
      ‹tl ms1 = []@hd(tl ms1)#tl(tl ms1)
      get_proc mx = get_proc (hd ms2)
      m  set (tl (tl ms1)). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      m  set (tl (tl ms1)). return_node m
      i<length ms1'. snd (s1' ! i) = snd (transfer (slice_kind S a) s2 ! i)
    have "((ms1',s1'),(ms1',transfer (slice_kind S a) s2))  WS S"
      by(auto intro!:WSI)
    with S,slice_kind S  (ms2,s2) =as@[a] (ms1',transfer (slice_kind S a) s2)
    show ?case by blast
  qed
qed



subsection ‹The weak simulation›

definition is_weak_sim :: 
  "(('node list × (('var  'val) × 'ret) list) × 
  ('node list × (('var  'val) × 'ret) list)) set  'node SDG_node set  bool"
  where "is_weak_sim R S  
  ms1 s1 ms2 s2 ms1' s1' as. 
    ((ms1,s1),(ms2,s2))  R  S,kind  (ms1,s1) =as (ms1',s1')  s1'  []
     (ms2' s2' as'. ((ms1',s1'),(ms2',s2'))  R  
                        S,slice_kind S  (ms2,s2) =as' (ms2',s2'))"


lemma WS_weak_sim:
  assumes "((ms1,s1),(ms2,s2))  WS S" 
  and "S,kind  (ms1,s1) =as (ms1',s1')" and "s1'  []"
  obtains as' where "((ms1',s1'),(ms1',transfer (slice_kind S (last as)) s2))  WS S"
  and "S,slice_kind S  (ms2,s2) =as'@[last as] 
                          (ms1',transfer (slice_kind S (last as)) s2)"
proof(atomize_elim)
  from S,kind  (ms1,s1) =as (ms1',s1') obtain ms' s' as' a'
    where "S,kind  (ms1,s1) =as'τ (ms',s')"
    and "S,kind  (ms',s') -a' (ms1',s1')" and "as = as'@[a']"
    by(fastforce elim:observable_moves.cases)
  from S,kind  (ms',s') -a' (ms1',s1')
  have "m  set (tl ms'). m'. call_of_return_node m m'  m'  HRB_slice SCFG"
    and "n  set (tl ms'). return_node n" and "ms'  []"
    by(auto elim:observable_move.cases simp:call_of_return_node_def)
  from S,kind  (ms1,s1) =as'τ (ms',s') ((ms1,s1),(ms2,s2))  WS S
  have "((ms',s'),(ms2,s2))  WS S" by(rule WS_silent_moves)
  with S,kind  (ms',s') -a' (ms1',s1') s1'  []
  obtain as'' where "((ms1',s1'),(ms1',transfer (slice_kind S a') s2))  WS S"
    and "S,slice_kind S  (ms2,s2) =as''@[a'] 
    (ms1',transfer (slice_kind S a') s2)"
    by(fastforce elim:WS_observable_move)
  with ((ms1',s1'),(ms1',transfer (slice_kind S a') s2))  WS S as = as'@[a']
  show "as'. ((ms1',s1'),(ms1',transfer (slice_kind S (last as)) s2))  WS S 
    S,slice_kind S  (ms2,s2) =as'@[last as] 
    (ms1',transfer (slice_kind S (last as)) s2)"
    by fastforce
qed



text ‹The following lemma states the correctness of static intraprocedural slicing:\\
  the simulation WS S› is a desired weak simulation›

theorem WS_is_weak_sim:"is_weak_sim (WS S) S"
by(fastforce elim:WS_weak_sim simp:is_weak_sim_def)

end

end

Theory FundamentalProperty

section ‹The fundamental property of slicing›

theory FundamentalProperty imports WeakSimulation SemanticsCFG begin

context SDG begin

subsection ‹Auxiliary lemmas for moves in the graph›

lemma observable_set_stack_in_slice:
  "S,f  (ms,s) -a (ms',s') 
   mx  set (tl ms'). mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG"
proof(induct rule:observable_move.induct)
  case (observable_move_intra f a s s' ms S ms') thus ?case by simp
next
  case (observable_move_call f a s s' Q r p fs a' ms S ms')
  from valid_edge a valid_edge a' a'  get_return_edges a
  have "call_of_return_node (targetnode a') (sourcenode a)"
    by(fastforce simp:return_node_def call_of_return_node_def)
  with ‹hd ms = sourcenode a ‹hd ms  HRB_slice SCFG 
    ms' = targetnode a # targetnode a' # tl ms
    mxset (tl ms). mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
  show ?case by fastforce
next
  case (observable_move_return f a s s' Q p f' ms S ms')
  thus ?case by(cases "tl ms") auto
qed


lemma silent_move_preserves_stacks:
  assumes "S,f  (m#ms,s) -aτ (m'#ms',s')" and "valid_call_list cs m"
  and "i < length rs. rs!i  get_return_edges (cs!i)" and "valid_return_list rs m"
  and "length rs = length cs" and "ms = targetnodes rs"
  obtains cs' rs' where "valid_node m'" and "valid_call_list cs' m'"
  and "i < length rs'. rs'!i  get_return_edges (cs'!i)"
  and "valid_return_list rs' m'" and "length rs' = length cs'" 
  and "ms' = targetnodes rs'" and "upd_cs cs [a] = cs'"
proof(atomize_elim)
  from assms show "cs' rs'. valid_node m'  valid_call_list cs' m' 
    (i<length rs'. rs' ! i  get_return_edges (cs' ! i)) 
    valid_return_list rs' m'  length rs' = length cs'  ms' = targetnodes rs' 
    upd_cs cs [a] = cs'"
  proof(induct S f "m#ms" s a "m'#ms'" s' rule:silent_move.induct)
    case (silent_move_intra f a s s' nc)
    from ‹hd (m # ms) = sourcenode a have "m = sourcenode a" by simp
    from m' # ms' = targetnode a # tl (m # ms)
    have [simp]:"m' = targetnode a" "ms' = ms" by simp_all
    from valid_edge a have "valid_node m'" by simp
    moreover
    from valid_edge a ‹intra_kind (kind a)
    have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
    from ‹valid_call_list cs m m = sourcenode a
      get_proc (sourcenode a) = get_proc (targetnode a)
    have "valid_call_list cs m'"
      apply(clarsimp simp:valid_call_list_def)
      apply(erule_tac x="cs'" in allE)
      apply(erule_tac x="c" in allE)
      by(auto split:list.split)
    moreover
    from ‹valid_return_list rs m m = sourcenode a 
      get_proc (sourcenode a) = get_proc (targetnode a)
    have "valid_return_list rs m'"
      apply(clarsimp simp:valid_return_list_def)
      apply(erule_tac x="cs'" in allE) apply clarsimp
      by(case_tac cs') auto
    moreover
    from ‹intra_kind (kind a) have "upd_cs cs [a] = cs"
      by(fastforce simp:intra_kind_def)
    ultimately show ?case using i<length rs. rs ! i  get_return_edges (cs ! i)
      ‹length rs = length cs ms = targetnodes rs
      apply(rule_tac x="cs" in exI)
      apply(rule_tac x="rs" in exI) 
      by clarsimp
  next
    case (silent_move_call f a s s' Q r p fs a' S)
    from ‹hd (m # ms) = sourcenode a 
      m' # ms' = targetnode a # targetnode a' # tl (m # ms)
    have [simp]:"m = sourcenode a" "m' = targetnode a" 
      "ms' = targetnode a' # tl (m # ms)"
      by simp_all
    from valid_edge a have "valid_node m'" by simp
    moreover
    from valid_edge a kind a = Q:rpfs have "get_proc (targetnode a) = p"
      by(rule get_proc_call)
    with ‹valid_call_list cs m valid_edge a kind a = Q:rpfs m = sourcenode a
    have "valid_call_list (a # cs) (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(case_tac cs') apply auto
      apply(erule_tac x="list" in allE)
      by(case_tac list)(auto simp:sourcenodes_def)
    moreover
    from i<length rs. rs ! i  get_return_edges (cs ! i) a'  get_return_edges a
    have "i<length (a'#rs). (a'#rs) ! i  get_return_edges ((a#cs) ! i)"
      by auto(case_tac i,auto)
    moreover
    from valid_edge a a'  get_return_edges a have "valid_edge a'" 
      by(rule get_return_edges_valid)
    from valid_edge a kind a = Q:rpfs a'  get_return_edges a
    obtain Q' f' where "kind a' = Q'pf'" by(fastforce dest!:call_return_edges)
    from valid_edge a' kind a' = Q'pf' have "get_proc (sourcenode a') = p"
      by(rule get_proc_return)
    from valid_edge a a'  get_return_edges a
    have "get_proc (sourcenode a) = get_proc (targetnode a')" 
      by(rule get_proc_get_return_edge)
    with ‹valid_return_list rs m valid_edge a' kind a' = Q'pf'
      get_proc (sourcenode a') = p get_proc (targetnode a) = p m = sourcenode a
    have "valid_return_list (a'#rs) (targetnode a)"
      apply(clarsimp simp:valid_return_list_def)
      apply(case_tac cs') apply auto
      apply(erule_tac x="list" in allE)
      by(case_tac list)(auto simp:targetnodes_def)
    moreover
    from ‹length rs = length cs have "length (a'#rs) = length (a#cs)" by simp
    moreover
    from ms = targetnodes rs have "targetnode a' # ms = targetnodes (a' # rs)"
      by(simp add:targetnodes_def)
    moreover
    from kind a = Q:rpfs have "upd_cs cs [a] = a#cs" by simp
    ultimately show ?case
      apply(rule_tac x="a#cs" in exI)
      apply(rule_tac x="a'#rs" in exI)
      by clarsimp
  next
    case (silent_move_return f a s s' Q p f' S)
    from ‹hd (m # ms) = sourcenode a
      ‹hd (tl (m # ms)) = targetnode a m' # ms' = tl (m # ms) [symmetric]
    have [simp]:"m = sourcenode a" "m' = targetnode a" by simp_all
    from ‹length (m # ms) = length s ‹length s = Suc (length s') s'  []
      ‹hd (tl (m # ms)) = targetnode a m' # ms' = tl (m # ms)
    have "ms = targetnode a # ms'" 
      by(cases ms) auto
    with ms = targetnodes rs
    obtain r' rs' where "rs = r' # rs'" 
      and "targetnode a = targetnode r'" and "ms' = targetnodes rs'" 
      by(cases rs)(auto simp:targetnodes_def)
    moreover
    from rs = r' # rs' ‹length rs = length cs obtain c' cs' where "cs = c' # cs'"
      and "length rs' = length cs'" by(cases cs) auto
    moreover
    from i<length rs. rs ! i  get_return_edges (cs ! i) 
      rs = r' # rs' cs = c' # cs'
    have "i<length rs'. rs' ! i  get_return_edges (cs' ! i)"
      and "r'  get_return_edges c'" by auto
    moreover
    from valid_edge a have "valid_node (targetnode a)" by simp
    moreover
    from ‹valid_call_list cs m cs = c' # cs'
    obtain p' Q' r fs' where "valid_edge c'" and "kind c' = Q':rp'fs'" 
      and "p' = get_proc m"
      apply(auto simp:valid_call_list_def)
      by(erule_tac x="[]" in allE) auto
    from valid_edge a kind a = Qpf'
    have "get_proc (sourcenode a) = p" by(rule get_proc_return)
    with p' = get_proc m have [simp]:"p' = p" by simp
    from valid_edge c' kind c' = Q':rp'fs'
    have "get_proc (targetnode c') = p" by(fastforce intro:get_proc_call)
    from valid_edge c' r'  get_return_edges c' have "valid_edge r'"
      by(rule get_return_edges_valid)
    from valid_edge c' kind c' = Q':rp'fs' r'  get_return_edges c'
    obtain Q'' f'' where "kind r' = Q''pf''" by(fastforce dest!:call_return_edges)
    with valid_edge r' have "get_proc (sourcenode r') = p" by(rule get_proc_return)
    from valid_edge r' kind r' = Q''pf'' have "method_exit (sourcenode r')" 
      by(fastforce simp:method_exit_def)
    from valid_edge a kind a = Qpf' have "method_exit (sourcenode a)" 
      by(fastforce simp:method_exit_def)
    with ‹method_exit (sourcenode r') get_proc (sourcenode r') = p 
      get_proc (sourcenode a) = p
    have "sourcenode a = sourcenode r'" by(fastforce intro:method_exit_unique)
    with valid_edge a valid_edge r' targetnode a = targetnode r'
    have "a = r'" by(fastforce intro:edge_det)
    from valid_edge c' r'  get_return_edges c' targetnode a = targetnode r'
    have "get_proc (sourcenode c') = get_proc (targetnode a)"
      by(fastforce intro:get_proc_get_return_edge)
    from ‹valid_call_list cs m cs = c' # cs'
      get_proc (sourcenode c') = get_proc (targetnode a)
    have "valid_call_list cs' (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(hypsubst_thin)
      apply(erule_tac x="c' # cs'" in allE)
      by(case_tac cs')(auto simp:sourcenodes_def)
    moreover
    from ‹valid_return_list rs m rs = r' # rs' targetnode a = targetnode r'
    have "valid_return_list rs' (targetnode a)"
      apply(clarsimp simp:valid_return_list_def)
      apply(erule_tac x="r' # cs'" in allE)
      by(case_tac cs')(auto simp:targetnodes_def)
    moreover
    from kind a = Qpf' cs = c' # cs' have "upd_cs cs [a] = cs'" by simp
    ultimately show ?case
      apply(rule_tac x="cs'" in exI)
      apply(rule_tac x="rs'" in exI)
      by clarsimp
  qed
qed


lemma silent_moves_preserves_stacks:
  assumes "S,f  (m#ms,s) =asτ (m'#ms',s')" 
  and "valid_node m" and "valid_call_list cs m"
  and "i < length rs. rs!i  get_return_edges (cs!i)" and "valid_return_list rs m"
  and "length rs = length cs" and "ms = targetnodes rs"
  obtains cs' rs' where "valid_node m'" and "valid_call_list cs' m'"
  and "i < length rs'. rs'!i  get_return_edges (cs'!i)"
  and "valid_return_list rs' m'" and "length rs' = length cs'" 
  and "ms' = targetnodes rs'" and "upd_cs cs as = cs'"
proof(atomize_elim)
  from assms show "cs' rs'. valid_node m'  valid_call_list cs' m' 
    (i<length rs'. rs' ! i  get_return_edges (cs' ! i)) 
    valid_return_list rs' m'  length rs' = length cs'  ms' = targetnodes rs' 
    upd_cs cs as = cs'"
  proof(induct S f "m#ms" s as "m'#ms'" s' 
      arbitrary:m ms cs rs rule:silent_moves.induct)
    case (silent_moves_Nil s nc f)
    thus ?case
      apply(rule_tac x="cs" in exI)
      apply(rule_tac x="rs" in exI)
      by clarsimp
  next
    case (silent_moves_Cons S f s a msx'' s'' as sx')
    note IH = m ms cs rs. msx'' = m # ms; valid_node m; valid_call_list cs m;
      i<length rs. rs ! i  get_return_edges (cs ! i);
      valid_return_list rs m; length rs = length cs; ms = targetnodes rs
       cs' rs'. valid_node m'  valid_call_list cs' m' 
      (i<length rs'. rs' ! i  get_return_edges (cs' ! i)) 
      valid_return_list rs' m'  length rs' = length cs'  ms' = targetnodes rs' 
      upd_cs cs as = cs'
    from S,f  (m # ms,s) -aτ (msx'',s'')
    obtain m'' ms'' where "msx'' = m''#ms''"
      by(cases msx'')(auto elim:silent_move.cases)
    with S,f  (m # ms,s) -aτ (msx'',s'') ‹valid_call_list cs m
      i<length rs. rs ! i  get_return_edges (cs ! i) ‹valid_return_list rs m
      ‹length rs = length cs ms = targetnodes rs
    obtain cs'' rs'' where hyps:"valid_node m''" "valid_call_list cs'' m''"
      "i < length rs''. rs''!i  get_return_edges (cs''!i)"
      "valid_return_list rs'' m''" "length rs'' = length cs''" 
      "ms'' = targetnodes rs''" and "upd_cs cs [a] = cs''"
      by(auto elim!:silent_move_preserves_stacks)
    from IH[OF _ hyps] msx'' = m'' # ms''
    obtain cs' rs' where results:"valid_node m'" "valid_call_list cs' m'"
      "i<length rs'. rs' ! i  get_return_edges (cs' ! i)"
      "valid_return_list rs' m'" "length rs' = length cs'" "ms' = targetnodes rs'"
      and "upd_cs cs'' as = cs'" by blast
    from ‹upd_cs cs [a] = cs'' ‹upd_cs cs'' as = cs' 
    have "upd_cs cs ([a] @ as) = cs'" by(rule upd_cs_Append)
    with results show ?case
      apply(rule_tac x="cs'" in exI)
      apply(rule_tac x="rs'" in exI)
      by clarsimp
  qed
qed


lemma observable_move_preserves_stacks:
  assumes "S,f  (m#ms,s) -a (m'#ms',s')" and "valid_call_list cs m"
  and "i < length rs. rs!i  get_return_edges (cs!i)" and "valid_return_list rs m"
  and "length rs = length cs" and "ms = targetnodes rs"
  obtains cs' rs' where "valid_node m'" and "valid_call_list cs' m'"
  and "i < length rs'. rs'!i  get_return_edges (cs'!i)"
  and "valid_return_list rs' m'" and "length rs' = length cs'" 
  and "ms' = targetnodes rs'" and "upd_cs cs [a] = cs'"
proof(atomize_elim)
  from assms show "cs' rs'. valid_node m'  valid_call_list cs' m' 
    (i<length rs'. rs' ! i  get_return_edges (cs' ! i)) 
    valid_return_list rs' m'  length rs' = length cs'  ms' = targetnodes rs' 
    upd_cs cs [a] = cs'"
  proof(induct S f "m#ms" s a "m'#ms'" s' rule:observable_move.induct)
    case (observable_move_intra f a s s' nc)
    from ‹hd (m # ms) = sourcenode a have "m = sourcenode a" by simp
    from m' # ms' = targetnode a # tl (m # ms)
    have [simp]:"m' = targetnode a" "ms' = ms" by simp_all
    from valid_edge a have "valid_node m'" by simp
    moreover
    from valid_edge a ‹intra_kind (kind a)
    have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
    from ‹valid_call_list cs m m = sourcenode a
      get_proc (sourcenode a) = get_proc (targetnode a)
    have "valid_call_list cs m'"
      apply(clarsimp simp:valid_call_list_def)
      apply(erule_tac x="cs'" in allE)
      apply(erule_tac x="c" in allE)
      by(auto split:list.split)
    moreover
    from ‹valid_return_list rs m m = sourcenode a 
      get_proc (sourcenode a) = get_proc (targetnode a)
    have "valid_return_list rs m'"
      apply(clarsimp simp:valid_return_list_def)
      apply(erule_tac x="cs'" in allE) apply clarsimp
      by(case_tac cs') auto
    moreover
    from ‹intra_kind (kind a) have "upd_cs cs [a] = cs"
      by(fastforce simp:intra_kind_def)
    ultimately show ?case using i<length rs. rs ! i  get_return_edges (cs ! i)
      ‹length rs = length cs ms = targetnodes rs
      apply(rule_tac x="cs" in exI)
      apply(rule_tac x="rs" in exI) 
      by clarsimp
  next
    case (observable_move_call f a s s' Q r p fs a' S)
    from ‹hd (m # ms) = sourcenode a 
      m' # ms' = targetnode a # targetnode a' # tl (m # ms)
    have [simp]:"m = sourcenode a" "m' = targetnode a" 
      "ms' = targetnode a' # tl (m # ms)"
      by simp_all
    from valid_edge a have "valid_node m'" by simp
    moreover
    from valid_edge a kind a = Q:rpfs have "get_proc (targetnode a) = p"
      by(rule get_proc_call)
    with ‹valid_call_list cs m valid_edge a kind a = Q:rpfs m = sourcenode a
    have "valid_call_list (a # cs) (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(case_tac cs') apply auto
      apply(erule_tac x="list" in allE)
      by(case_tac list)(auto simp:sourcenodes_def)
    moreover
    from i<length rs. rs ! i  get_return_edges (cs ! i) a'  get_return_edges a
    have "i<length (a'#rs). (a'#rs) ! i  get_return_edges ((a#cs) ! i)"
      by auto(case_tac i,auto)
    moreover
    from valid_edge a a'  get_return_edges a have "valid_edge a'" 
      by(rule get_return_edges_valid)
    from valid_edge a kind a = Q:rpfs a'  get_return_edges a
    obtain Q' f' where "kind a' = Q'pf'" by(fastforce dest!:call_return_edges)
    from valid_edge a' kind a' = Q'pf' have "get_proc (sourcenode a') = p"
      by(rule get_proc_return)
    from valid_edge a a'  get_return_edges a
    have "get_proc (sourcenode a) = get_proc (targetnode a')" 
      by(rule get_proc_get_return_edge)
    with ‹valid_return_list rs m valid_edge a' kind a' = Q'pf'
      get_proc (sourcenode a') = p get_proc (targetnode a) = p m = sourcenode a
    have "valid_return_list (a'#rs) (targetnode a)"
      apply(clarsimp simp:valid_return_list_def)
      apply(case_tac cs') apply auto
      apply(erule_tac x="list" in allE)
      by(case_tac list)(auto simp:targetnodes_def)
    moreover
    from ‹length rs = length cs have "length (a'#rs) = length (a#cs)" by simp
    moreover
    from ms = targetnodes rs have "targetnode a' # ms = targetnodes (a' # rs)"
      by(simp add:targetnodes_def)
    moreover
    from kind a = Q:rpfs have "upd_cs cs [a] = a#cs" by simp
    ultimately show ?case
      apply(rule_tac x="a#cs" in exI)
      apply(rule_tac x="a'#rs" in exI)
      by clarsimp
  next
    case (observable_move_return f a s s' Q p f' S)
    from ‹hd (m # ms) = sourcenode a
      ‹hd (tl (m # ms)) = targetnode a m' # ms' = tl (m # ms) [symmetric]
    have [simp]:"m = sourcenode a" "m' = targetnode a" by simp_all
    from ‹length (m # ms) = length s ‹length s = Suc (length s') s'  []
      ‹hd (tl (m # ms)) = targetnode a m' # ms' = tl (m # ms)
    have "ms = targetnode a # ms'" 
      by(cases ms) auto
    with ms = targetnodes rs
    obtain r' rs' where "rs = r' # rs'" 
      and "targetnode a = targetnode r'" and "ms' = targetnodes rs'" 
      by(cases rs)(auto simp:targetnodes_def)
    moreover
    from rs = r' # rs' ‹length rs = length cs obtain c' cs' where "cs = c' # cs'"
      and "length rs' = length cs'" by(cases cs) auto
    moreover
    from i<length rs. rs ! i  get_return_edges (cs ! i) 
      rs = r' # rs' cs = c' # cs'
    have "i<length rs'. rs' ! i  get_return_edges (cs' ! i)"
      and "r'  get_return_edges c'" by auto
    moreover
    from valid_edge a have "valid_node (targetnode a)" by simp
    moreover
    from ‹valid_call_list cs m cs = c' # cs'
    obtain p' Q' r fs' where "valid_edge c'" and "kind c' = Q':rp'fs'" 
      and "p' = get_proc m"
      apply(auto simp:valid_call_list_def)
      by(erule_tac x="[]" in allE) auto
    from valid_edge a kind a = Qpf'
    have "get_proc (sourcenode a) = p" by(rule get_proc_return)
    with p' = get_proc m have [simp]:"p' = p" by simp
    from valid_edge c' kind c' = Q':rp'fs'
    have "get_proc (targetnode c') = p" by(fastforce intro:get_proc_call)
    from valid_edge c' r'  get_return_edges c' have "valid_edge r'"
      by(rule get_return_edges_valid)
    from valid_edge c' kind c' = Q':rp'fs' r'  get_return_edges c'
    obtain Q'' f'' where "kind r' = Q''pf''" by(fastforce dest!:call_return_edges)
    with valid_edge r' have "get_proc (sourcenode r') = p" by(rule get_proc_return)
    from valid_edge r' kind r' = Q''pf'' have "method_exit (sourcenode r')" 
      by(fastforce simp:method_exit_def)
    from valid_edge a kind a = Qpf' have "method_exit (sourcenode a)" 
      by(fastforce simp:method_exit_def)
    with ‹method_exit (sourcenode r') get_proc (sourcenode r') = p 
      get_proc (sourcenode a) = p
    have "sourcenode a = sourcenode r'" by(fastforce intro:method_exit_unique)
    with valid_edge a valid_edge r' targetnode a = targetnode r'
    have "a = r'" by(fastforce intro:edge_det)
    from valid_edge c' r'  get_return_edges c' targetnode a = targetnode r'
    have "get_proc (sourcenode c') = get_proc (targetnode a)"
      by(fastforce intro:get_proc_get_return_edge)
    from ‹valid_call_list cs m cs = c' # cs'
      get_proc (sourcenode c') = get_proc (targetnode a)
    have "valid_call_list cs' (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(hypsubst_thin)
      apply(erule_tac x="c' # cs'" in allE)
      by(case_tac cs')(auto simp:sourcenodes_def)
    moreover
    from ‹valid_return_list rs m rs = r' # rs' targetnode a = targetnode r'
    have "valid_return_list rs' (targetnode a)"
      apply(clarsimp simp:valid_return_list_def)
      apply(erule_tac x="r' # cs'" in allE)
      by(case_tac cs')(auto simp:targetnodes_def)
    moreover
    from kind a = Qpf' cs = c' # cs' have "upd_cs cs [a] = cs'" by simp
    ultimately show ?case
      apply(rule_tac x="cs'" in exI)
      apply(rule_tac x="rs'" in exI)
      by clarsimp
  qed
qed


lemma observable_moves_preserves_stack:
  assumes "S,f  (m#ms,s) =as (m'#ms',s')" 
  and "valid_node m" and "valid_call_list cs m"
  and "i < length rs. rs!i  get_return_edges (cs!i)" and "valid_return_list rs m"
  and "length rs = length cs" and "ms = targetnodes rs"
  obtains cs' rs' where "valid_node m'" and "valid_call_list cs' m'"
  and "i < length rs'. rs'!i  get_return_edges (cs'!i)"
  and "valid_return_list rs' m'" and "length rs' = length cs'" 
  and "ms' = targetnodes rs'" and "upd_cs cs as = cs'"
proof(atomize_elim)
  from S,f  (m#ms,s) =as (m'#ms',s') obtain msx s'' as' a'
    where "as = as'@[a']" and "S,f  (m#ms,s) =as'τ (msx,s'')"
    and "S,f  (msx,s'') -a' (m'#ms',s')"
    by(fastforce elim:observable_moves.cases)
  from S,f  (msx,s'') -a' (m'#ms',s') obtain m'' ms''
    where [simp]:"msx = m''#ms''" by(cases msx)(auto elim:observable_move.cases)
  from S,f  (m#ms,s) =as'τ (msx,s'') ‹valid_node m ‹valid_call_list cs m
    i < length rs. rs!i  get_return_edges (cs!i) ‹valid_return_list rs m
    ‹length rs = length cs ms = targetnodes rs
  obtain cs'' rs'' where "valid_node m''" and "valid_call_list cs'' m''"
    and "i < length rs''. rs''!i  get_return_edges (cs''!i)"
    and "valid_return_list rs'' m''" and "length rs'' = length cs''" 
    and "ms'' = targetnodes rs''" and "upd_cs cs as' = cs''"
    by(auto elim!:silent_moves_preserves_stacks)
  with S,f  (msx,s'') -a' (m'#ms',s')
  obtain cs' rs' where results:"valid_node m'" "valid_call_list cs' m'"
    "i<length rs'. rs' ! i  get_return_edges (cs' ! i)"
    "valid_return_list rs' m'" "length rs' = length cs'" "ms' = targetnodes rs'"
    and "upd_cs cs'' [a'] = cs'"
    by(auto elim!:observable_move_preserves_stacks)
  from ‹upd_cs cs as' = cs'' ‹upd_cs cs'' [a'] = cs'
  have "upd_cs cs (as'@[a']) = cs'" by(rule upd_cs_Append)
  with as = as'@[a'] results
  show "cs' rs'. valid_node m'  valid_call_list cs' m' 
    (i<length rs'. rs' ! i  get_return_edges (cs' ! i)) 
    valid_return_list rs' m'  length rs' = length cs'  ms' = targetnodes rs' 
    upd_cs cs as = cs'"
    apply(rule_tac x="cs'" in exI)
    apply(rule_tac x="rs'" in exI)
    by clarsimp
qed


lemma silent_moves_slpa_path:
  "S,f  (m#ms''@ms,s) =asτ (m'#ms',s'); valid_node m; valid_call_list cs m;
  i < length rs. rs!i  get_return_edges (cs!i); valid_return_list rs m; 
  length rs = length cs; ms'' = targetnodes rs;
  mx  set ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG;
  ms''  []  (mx'. call_of_return_node (last ms'') mx'  mx'  HRB_slice SCFG);
  mx  set ms'. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
   same_level_path_aux cs as  upd_cs cs as = []  m -as→* m'  ms = ms'"
proof(induct S f "m#ms''@ms" s as "m'#ms'" s' arbitrary:m ms'' ms cs rs
    rule:silent_moves.induct)
  case (silent_moves_Nil sx S f) thus ?case
    apply(cases ms'' rule:rev_cases) apply(auto intro:empty_path simp:targetnodes_def)
    by(cases rs rule:rev_cases,auto)+
next
  case (silent_moves_Cons S f sx a msx' sx' as sx'')
  thus ?case
  proof(induct _ _ "m#ms''@ms" _ _ _ _ rule:silent_move.induct)
    case (silent_move_intra f a s s' S msx')
    note IH = m ms'' ms cs rs. msx' = m # ms'' @ ms; valid_node m; 
      valid_call_list cs m; i<length rs. rs ! i  get_return_edges (cs ! i);
      valid_return_list rs m; length rs = length cs; ms'' = targetnodes rs;
      mxset ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG;
      ms''  [] 
        (mx'. call_of_return_node (last ms'') mx'  mx'  HRB_slice SCFG);
      mxset ms'. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
       same_level_path_aux cs as  upd_cs cs as = []  m -as→* m'  ms = ms'
    note callstack = mxset ms. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG
    note callstack'' = ms''  [] 
      (mx'. call_of_return_node (last ms'') mx'  mx'  HRB_slice SCFG)
    note callstack' = mxset ms'. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG
    from valid_edge a have "valid_node (targetnode a)" by simp
    from valid_edge a ‹intra_kind (kind a)
    have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
    from ‹hd (m # ms'' @ ms) = sourcenode a have "m = sourcenode a" 
      by simp
    from ‹valid_call_list cs m m = sourcenode a
      get_proc (sourcenode a) = get_proc (targetnode a)
    have "valid_call_list cs (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(erule_tac x="cs'" in allE)
      apply(erule_tac x="c" in allE)
      by(auto split:list.split)
    from ‹valid_return_list rs m m = sourcenode a 
      get_proc (sourcenode a) = get_proc (targetnode a)
    have "valid_return_list rs (targetnode a)"
      apply(clarsimp simp:valid_return_list_def)
      apply(erule_tac x="cs'" in allE) apply clarsimp
      by(case_tac cs') auto
    from msx' = targetnode a # tl (m # ms'' @ ms)
    have "msx' = targetnode a # ms'' @ ms" by simp
    from IH[OF this ‹valid_node (targetnode a) ‹valid_call_list cs (targetnode a)
      i<length rs. rs ! i  get_return_edges (cs ! i) 
      ‹valid_return_list rs (targetnode a) ‹length rs = length cs
      ms'' = targetnodes rs callstack callstack'' callstack']
    have "same_level_path_aux cs as" and "upd_cs cs as = []"
      and "targetnode a -as→* m'" and "ms = ms'" by simp_all
    from ‹intra_kind (kind a) ‹same_level_path_aux cs as
    have "same_level_path_aux cs (a # as)" by(fastforce simp:intra_kind_def)
    moreover
    from ‹intra_kind (kind a) ‹upd_cs cs as = []
    have "upd_cs cs (a # as) = []" by(fastforce simp:intra_kind_def)
    moreover
    from valid_edge a m = sourcenode a targetnode a -as→* m'
    have "m -a # as→* m'" by(fastforce intro:Cons_path)
    ultimately show ?case using ms = ms' by simp
  next
    case (silent_move_call f a s s' Q r p fs a' S msx')
    note IH = m ms'' ms cs rs. msx' = m # ms'' @ ms; valid_node m; valid_call_list cs m;
      i<length rs. rs ! i  get_return_edges (cs ! i); valid_return_list rs m;
      length rs = length cs; ms'' = targetnodes rs;
      mxset ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG;
      ms''  [] 
        (mx'. call_of_return_node (last ms'') mx'  mx'  HRB_slice SCFG);
      mxset ms'. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
       same_level_path_aux cs as  upd_cs cs as = []  m -as→* m'  ms = ms'
    note callstack = mxset ms. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG
    note callstack'' = ms''  [] 
      (mx'. call_of_return_node (last ms'') mx'  mx'  HRB_slice SCFG)
    note callstack' = mxset ms'. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG
    from valid_edge a have "valid_node (targetnode a)" by simp
    from ‹hd (m # ms'' @ ms) = sourcenode a have "m = sourcenode a" 
      by simp
    from valid_edge a kind a = Q:rpfs have "get_proc (targetnode a) = p"
      by(rule get_proc_call)
    with ‹valid_call_list cs m valid_edge a kind a = Q:rpfs m = sourcenode a
    have "valid_call_list (a # cs) (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(case_tac cs') apply auto
      apply(erule_tac x="list" in allE)
      by(case_tac list)(auto simp:sourcenodes_def)
    from i<length rs. rs ! i  get_return_edges (cs ! i) a'  get_return_edges a
    have "i<length (a'#rs). (a'#rs) ! i  get_return_edges ((a#cs) ! i)"
      by auto(case_tac i,auto)
    from valid_edge a a'  get_return_edges a have "valid_edge a'" 
      by(rule get_return_edges_valid)
    from valid_edge a kind a = Q:rpfs a'  get_return_edges a
    obtain Q' f' where "kind a' = Q'pf'" by(fastforce dest!:call_return_edges)
    from valid_edge a' kind a' = Q'pf' have "get_proc (sourcenode a') = p"
      by(rule get_proc_return)
    from valid_edge a a'  get_return_edges a
    have "get_proc (sourcenode a) = get_proc (targetnode a')" 
      by(rule get_proc_get_return_edge)
    with ‹valid_return_list rs m valid_edge a' kind a' = Q'pf'
      get_proc (sourcenode a') = p get_proc (targetnode a) = p m = sourcenode a
    have "valid_return_list (a'#rs) (targetnode a)"
      apply(clarsimp simp:valid_return_list_def)
      apply(case_tac cs') apply auto
      apply(erule_tac x="list" in allE)
      by(case_tac list)(auto simp:targetnodes_def)
    from ‹length rs = length cs have "length (a'#rs) = length (a # cs)" by simp
    from ms'' = targetnodes rs
    have "targetnode a' # ms'' = targetnodes (a'#rs)" by(simp add:targetnodes_def)
    from msx' = targetnode a # targetnode a' # tl (m # ms'' @ ms)
    have "msx' = targetnode a # targetnode a' # ms'' @ ms" by simp
    have "mx'. call_of_return_node (last (targetnode a' # ms'')) mx' 
      mx'  HRB_slice SCFG"
    proof(cases "ms'' = []")
      case True
      with (mset (tl (m # ms'' @ ms)).
        m'. call_of_return_node m m'  m'  HRB_slice SCFG) 
        hd (m # ms'' @ ms)  HRB_slice SCFG m = sourcenode a callstack
      have "sourcenode a  HRB_slice SCFG" by fastforce
      from valid_edge a a'  get_return_edges a have "valid_edge a'"
        by(rule get_return_edges_valid)
      with valid_edge a a'  get_return_edges a
      have "call_of_return_node (targetnode a') (sourcenode a)"
        by(fastforce simp:call_of_return_node_def return_node_def)
      with sourcenode a  HRB_slice SCFG True show ?thesis by fastforce
    next
      case False
      with callstack'' show ?thesis by fastforce
    qed
    hence "targetnode a' # ms''  [] 
      (mx'. call_of_return_node (last (targetnode a' # ms'')) mx' 
      mx'  HRB_slice SCFG)" by simp
    from IH[OF _ ‹valid_node (targetnode a) ‹valid_call_list (a # cs) (targetnode a)
      i<length (a'#rs). (a'#rs) ! i  get_return_edges ((a#cs) ! i)
      ‹valid_return_list (a'#rs) (targetnode a) ‹length (a'#rs) = length (a # cs)
      targetnode a' # ms'' = targetnodes (a'#rs) callstack this callstack']
      msx' = targetnode a # targetnode a' # ms'' @ ms
    have "same_level_path_aux (a # cs) as" and "upd_cs (a # cs) as = []"
      and "targetnode a -as→* m'" and "ms = ms'" by simp_all
    from kind a = Q:rpfs ‹same_level_path_aux (a # cs) as
    have "same_level_path_aux cs (a # as)" by simp
    moreover
    from kind a = Q:rpfs ‹upd_cs (a # cs) as = [] have "upd_cs cs (a # as) = []"
      by simp
    moreover
    from valid_edge a m = sourcenode a targetnode a -as→* m'
    have "m -a # as→* m'" by(fastforce intro:Cons_path)
    ultimately show ?case using ms = ms' by simp
  next
    case (silent_move_return f a s s' Q p f' S msx')
    note IH = m ms'' ms cs rs. msx' = m # ms'' @ ms; valid_node m; 
      valid_call_list cs m; i<length rs. rs ! i  get_return_edges (cs ! i); 
      valid_return_list rs m; length rs = length cs; ms'' = targetnodes rs;
      mxset ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG;
      ms''  [] 
        (mx'. call_of_return_node (last ms'') mx'  mx'  HRB_slice SCFG);
      mxset ms'. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
       same_level_path_aux cs as  upd_cs cs as = []  m -as→* m'  ms = ms'
    note callstack = mxset ms. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG
    note callstack'' = ms''  [] 
      (mx'. call_of_return_node (last ms'') mx'  mx'  HRB_slice SCFG)
    note callstack' = mxset ms'. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG
    have "ms''  []"
    proof
      assume "ms'' = []"
      with callstack
        mset (tl (m # ms'' @ ms)). m'. call_of_return_node m m'  m'  HRB_slice SCFG
      show False by fastforce
    qed
    with ‹hd (tl (m # ms'' @ ms)) = targetnode a
    obtain xs where "ms'' = targetnode a # xs" by(cases ms'') auto
    with ms'' = targetnodes rs obtain r' rs' where "rs = r' # rs'" 
      and "targetnode a = targetnode r'" and "xs = targetnodes rs'" 
      by(cases rs)(auto simp:targetnodes_def)
    from rs = r' # rs' ‹length rs = length cs obtain c' cs' where "cs = c' # cs'"
      and "length rs' = length cs'" by(cases cs) auto
    from i<length rs. rs ! i  get_return_edges (cs ! i) 
      rs = r' # rs' cs = c' # cs'
    have "i<length rs'. rs' ! i  get_return_edges (cs' ! i)"
      and "r'  get_return_edges c'" by auto
    from valid_edge a have "valid_node (targetnode a)" by simp
    from ‹hd (m # ms'' @ ms) = sourcenode a have "m = sourcenode a" 
      by simp
    from ‹valid_call_list cs m cs = c' # cs'
    obtain p' Q' r fs' where "valid_edge c'" and "kind c' = Q':rp'fs'" 
      and "p' = get_proc m"
      apply(auto simp:valid_call_list_def)
      by(erule_tac x="[]" in allE) auto
    from valid_edge a kind a = Qpf'
    have "get_proc (sourcenode a) = p" by(rule get_proc_return)
    with m = sourcenode a p' = get_proc m have [simp]:"p' = p" by simp
    from valid_edge c' kind c' = Q':rp'fs'
    have "get_proc (targetnode c') = p" by(fastforce intro:get_proc_call)
    from valid_edge c' r'  get_return_edges c' have "valid_edge r'"
      by(rule get_return_edges_valid)
    from valid_edge c' kind c' = Q':rp'fs' r'  get_return_edges c'
    obtain Q'' f'' where "kind r' = Q''pf''" by(fastforce dest!:call_return_edges)
    with valid_edge r' have "get_proc (sourcenode r') = p" by(rule get_proc_return)
    from valid_edge r' kind r' = Q''pf'' have "method_exit (sourcenode r')" 
      by(fastforce simp:method_exit_def)
    from valid_edge a kind a = Qpf' have "method_exit (sourcenode a)" 
      by(fastforce simp:method_exit_def)
    with ‹method_exit (sourcenode r') get_proc (sourcenode r') = p 
      get_proc (sourcenode a) = p
    have "sourcenode a = sourcenode r'" by(fastforce intro:method_exit_unique)
    with valid_edge a valid_edge r' targetnode a = targetnode r'
    have "a = r'" by(fastforce intro:edge_det)
    from valid_edge c' r'  get_return_edges c' targetnode a = targetnode r'
    have "get_proc (sourcenode c') = get_proc (targetnode a)"
      by(fastforce intro:get_proc_get_return_edge)
    from ‹valid_call_list cs m cs = c' # cs'
      get_proc (sourcenode c') = get_proc (targetnode a)
    have "valid_call_list cs' (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(hypsubst_thin)
      apply(erule_tac x="c' # cs'" in allE)
      by(case_tac cs')(auto simp:sourcenodes_def)
    from ‹valid_return_list rs m rs = r' # rs' targetnode a = targetnode r'
    have "valid_return_list rs' (targetnode a)"
      apply(clarsimp simp:valid_return_list_def)
      apply(erule_tac x="r' # cs'" in allE)
      by(case_tac cs')(auto simp:targetnodes_def)
    from msx' = tl (m # ms'' @ ms) ms'' = targetnode a # xs
    have "msx' = targetnode a # xs @ ms" by simp
    from callstack'' ms'' = targetnode a # xs
    have "xs  [] 
      (mx'. call_of_return_node (last xs) mx'  mx'  HRB_slice SCFG)"
      by fastforce
    from IH[OF msx' = targetnode a # xs @ ms ‹valid_node (targetnode a)
      ‹valid_call_list cs' (targetnode a)
      i<length rs'. rs' ! i  get_return_edges (cs' ! i) 
      ‹valid_return_list rs' (targetnode a) ‹length rs' = length cs'
      xs = targetnodes rs' callstack this callstack']
    have "same_level_path_aux cs' as" and "upd_cs cs' as = []"
      and "targetnode a -as→* m'" and "ms = ms'" by simp_all
    from kind a = Qpf' ‹same_level_path_aux cs' as cs = c' # cs'
      r'  get_return_edges c' a = r'
    have "same_level_path_aux cs (a # as)" by simp
    moreover
    from ‹upd_cs cs' as = [] kind a = Qpf' cs = c' # cs'
    have "upd_cs cs (a # as) = []" by simp
    moreover
    from valid_edge a m = sourcenode a targetnode a -as→* m'
    have "m -a # as→* m'" by(fastforce intro:Cons_path)
    ultimately show ?case using ms = ms' by simp
  qed
qed


lemma silent_moves_slp:
  "S,f  (m#ms,s) =asτ (m'#ms',s'); valid_node m; 
  mx  set ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG;
  mx  set ms'. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
   m -assl* m'  ms = ms'"
  by(fastforce dest!:silent_moves_slpa_path
                   [of _ _ _ "[]" _ _ _ _ _ _ "[]" "[]",simplified] 
              simp:targetnodes_def valid_call_list_def valid_return_list_def 
                   same_level_path_def slp_def)


lemma slpa_silent_moves_callstacks_eq:
  "same_level_path_aux cs as; S,f  (m#msx@ms,s) =asτ (m'#ms',s');
  length ms = length ms'; valid_call_list cs m; 
  i < length rs. rs!i  get_return_edges (cs!i); valid_return_list rs m; 
  length rs = length cs; msx = targetnodes rs
   ms = ms'"
proof(induct arbitrary:m msx s rs rule:slpa_induct)
  case (slpa_empty cs)
  from S,f  (m # msx @ ms,s) =[]τ (m' # ms',s')
  have "msx@ms = ms'" by(fastforce elim:silent_moves.cases)
  with ‹length ms = length ms' show ?case by fastforce
next
  case (slpa_intra cs a as)
  note IH = m msx s rs. S,f  (m # msx @ ms,s) =asτ (m' # ms',s');
    length ms = length ms'; valid_call_list cs m;
    i<length rs. rs ! i  get_return_edges (cs ! i);
    valid_return_list rs m; length rs = length cs; msx = targetnodes rs
     ms = ms'
  from S,f  (m # msx @ ms,s) =a # asτ (m' # ms',s') obtain ms'' s''
  where "S,f  (m # msx @ ms,s) -aτ (ms'',s'')"
    and "S,f  (ms'',s'') =asτ (m' # ms',s')"
    by(auto elim:silent_moves.cases)
  from S,f  (m # msx @ ms,s) -aτ (ms'',s'') ‹intra_kind (kind a)
  have "valid_edge a" and [simp]:"m = sourcenode a" "ms'' = targetnode a # msx @ ms"
    by(fastforce elim:silent_move.cases simp:intra_kind_def)+
  from valid_edge a ‹intra_kind (kind a)
  have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
  from ‹valid_call_list cs m m = sourcenode a
    get_proc (sourcenode a) = get_proc (targetnode a)
  have "valid_call_list cs (targetnode a)"
    apply(clarsimp simp:valid_call_list_def)
    apply(erule_tac x="cs'" in allE)
    apply(erule_tac x="c" in allE)
    by(auto split:list.split)
  from ‹valid_return_list rs m m = sourcenode a 
    get_proc (sourcenode a) = get_proc (targetnode a)
  have "valid_return_list rs (targetnode a)"
    apply(clarsimp simp:valid_return_list_def)
    apply(erule_tac x="cs'" in allE) apply clarsimp
    by(case_tac cs') auto
  from S,f  (ms'',s'') =asτ (m' # ms',s')
  have "S,f  (targetnode a # msx @ ms,s'') =asτ (m' # ms',s')" by simp
  from IH[OF this ‹length ms = length ms' ‹valid_call_list cs (targetnode a)
    i<length rs. rs ! i  get_return_edges (cs ! i) 
    ‹valid_return_list rs (targetnode a) ‹length rs = length cs
    msx = targetnodes rs] show ?case .
next
  case (slpa_Call cs a as Q r p fs)
  note IH = m msx s rs. S,f  (m # msx @ ms,s) =asτ (m' # ms',s');
    length ms = length ms'; valid_call_list (a # cs) m;
    i<length rs. rs ! i  get_return_edges ((a # cs) ! i);
    valid_return_list rs m; length rs = length (a # cs);
    msx = targetnodes rs
     ms = ms'
  from S,f  (m # msx @ ms,s) =a # asτ (m' # ms',s') obtain ms'' s''
    where "S,f  (m # msx @ ms,s) -aτ (ms'',s'')"
    and "S,f  (ms'',s'') =asτ (m' # ms',s')"
    by(auto elim:silent_moves.cases)
  from S,f  (m # msx @ ms,s) -aτ (ms'',s'') kind a = Q:rpfs
  obtain a' where "valid_edge a" and [simp]:"m = sourcenode a"
    and [simp]:"ms'' = targetnode a # targetnode a' # msx @ ms"
    and "a'  get_return_edges a"
    by(auto elim:silent_move.cases simp:intra_kind_def)
  from valid_edge a kind a = Q:rpfs have "get_proc (targetnode a) = p"
    by(rule get_proc_call)
  with ‹valid_call_list cs m valid_edge a kind a = Q:rpfs m = sourcenode a
  have "valid_call_list (a # cs) (targetnode a)"
    apply(clarsimp simp:valid_call_list_def)
    apply(case_tac cs') apply auto
    apply(erule_tac x="list" in allE)
    by(case_tac list)(auto simp:sourcenodes_def)
  from i<length rs. rs ! i  get_return_edges (cs ! i) a'  get_return_edges a
  have "i<length (a'#rs). (a'#rs) ! i  get_return_edges ((a#cs) ! i)"
    by auto(case_tac i,auto)
  from valid_edge a a'  get_return_edges a have "valid_edge a'" 
    by(rule get_return_edges_valid)
  from valid_edge a kind a = Q:rpfs a'  get_return_edges a
  obtain Q' f' where "kind a' = Q'pf'" by(fastforce dest!:call_return_edges)
  from valid_edge a' kind a' = Q'pf' have "get_proc (sourcenode a') = p"
    by(rule get_proc_return)
  from valid_edge a a'  get_return_edges a
  have "get_proc (sourcenode a) = get_proc (targetnode a')" 
    by(rule get_proc_get_return_edge)
  with ‹valid_return_list rs m valid_edge a' kind a' = Q'pf'
    get_proc (sourcenode a') = p get_proc (targetnode a) = p m = sourcenode a
  have "valid_return_list (a'#rs) (targetnode a)"
    apply(clarsimp simp:valid_return_list_def)
    apply(case_tac cs') apply auto
    apply(erule_tac x="list" in allE)
    by(case_tac list)(auto simp:targetnodes_def)
  from ‹length rs = length cs have "length (a'#rs) = length (a#cs)" by simp
  from msx = targetnodes rs have "targetnode a' # msx = targetnodes (a' # rs)"
    by(simp add:targetnodes_def)
  from S,f  (ms'',s'') =asτ (m' # ms',s')
  have "S,f  (targetnode a # (targetnode a' # msx) @ ms,s'') =asτ (m' # ms',s')"
    by simp
  from IH[OF this ‹length ms = length ms' ‹valid_call_list (a # cs) (targetnode a)
    i<length (a'#rs). (a'#rs) ! i  get_return_edges ((a#cs) ! i)
    ‹valid_return_list (a'#rs) (targetnode a) ‹length (a'#rs) = length (a#cs)
    targetnode a' # msx = targetnodes (a' # rs)] show ?case .
next
  case (slpa_Return cs a as Q p f' c' cs')
  note IH = m msx s rs. S,f  (m # msx @ ms,s) =asτ (m' # ms',s');
    length ms = length ms'; valid_call_list cs' m;
    i<length rs. rs ! i  get_return_edges (cs' ! i); valid_return_list rs m; 
    length rs = length cs'; msx = targetnodes rs
     ms = ms'
  from S,f  (m # msx @ ms,s) =a # asτ (m' # ms',s') obtain ms'' s''
    where "S,f  (m # msx @ ms,s) -aτ (ms'',s'')"
    and "S,f  (ms'',s'') =asτ (m' # ms',s')"
    by(auto elim:silent_moves.cases)
  from S,f  (m # msx @ ms,s) -aτ (ms'',s'') kind a = Qpf'
  have "valid_edge a" and "m = sourcenode a" and "hd (msx @ ms) = targetnode a"
    and "ms'' = msx @ ms" and "s''  []" and "length s = Suc(length s'')"
    and "length (m # msx @ ms) = length s"
    by(auto elim:silent_move.cases simp:intra_kind_def)
  from msx = targetnodes rs ‹length rs = length cs cs = c' # cs'
  obtain mx' msx' where "msx = mx'#msx'"
    by(cases msx)(fastforce simp:targetnodes_def)+
  with ‹hd (msx @ ms) = targetnode a have "mx' = targetnode a" by simp
  from ‹valid_call_list cs m cs = c' # cs' have "valid_edge c'"
    by(fastforce simp:valid_call_list_def)
  from valid_edge c' a  get_return_edges c'
  have "get_proc (sourcenode c') = get_proc (targetnode a)"
    by(rule get_proc_get_return_edge)
  from ‹valid_call_list cs m cs = c' # cs'
    get_proc (sourcenode c') = get_proc (targetnode a)
  have "valid_call_list cs' (targetnode a)"
    apply(clarsimp simp:valid_call_list_def)
    apply(hypsubst_thin)
    apply(erule_tac x="c' # cs'" in allE)
    by(case_tac cs')(auto simp:sourcenodes_def)
  from ‹length rs = length cs cs = c' # cs' obtain r' rs' 
    where [simp]:"rs = r'#rs'" and "length rs' = length cs'" by(cases rs) auto
  from i<length rs. rs ! i  get_return_edges (cs ! i) cs = c' # cs'
  have "i<length rs'. rs' ! i  get_return_edges (cs' ! i)"
    and "r'  get_return_edges c'" by auto
  with valid_edge c' a  get_return_edges c' have [simp]:"a = r'" 
    by -(rule get_return_edges_unique)
  with ‹valid_return_list rs m 
  have "valid_return_list rs' (targetnode a)"
    apply(clarsimp simp:valid_return_list_def)
    apply(erule_tac x="r' # cs'" in allE)
    by(case_tac cs')(auto simp:targetnodes_def)
  from msx = targetnodes rs msx = mx'#msx' rs = r'#rs'
  have "msx' = targetnodes rs'" by(simp add:targetnodes_def)
  from S,f  (ms'',s'') =asτ (m' # ms',s') msx = mx'#msx'
    ms'' = msx @ ms mx' = targetnode a
  have "S,f  (targetnode a # msx' @ ms,s'') =asτ (m' # ms',s')" by simp
  from IH[OF this ‹length ms = length ms' ‹valid_call_list cs' (targetnode a)
    i<length rs'. rs' ! i  get_return_edges (cs' ! i)
    ‹valid_return_list rs' (targetnode a) ‹length rs' = length cs'
    msx' = targetnodes rs'] show ?case .
qed


lemma silent_moves_same_level_path:
  assumes "S,kind  (m#ms,s) =asτ (m'#ms',s')" and "m -assl* m'" shows "ms = ms'"
proof -
  from S,kind  (m#ms,s) =asτ (m'#ms',s') obtain cf cfs where "s = cf#cfs"
    by(cases s)(auto dest:silent_moves_equal_length)
  with S,kind  (m#ms,s) =asτ (m'#ms',s') 
  have "transfers (kinds as) (cf#cfs) = s'"
    by(fastforce intro:silent_moves_preds_transfers simp:kinds_def)
  with m -assl* m' obtain cf' where "s' = cf'#cfs"
    by -(drule slp_callstack_length_equal,auto)
  from S,kind  (m#ms,s) =asτ (m'#ms',s')
  have "length (m#ms) = length s" and "length (m'#ms') = length s'" 
    by(rule silent_moves_equal_length)+
  with s = cf#cfs s' = cf'#cfs have "length ms = length ms'" by simp
  from m -assl* m' have "same_level_path_aux [] as"
    by(simp add:slp_def same_level_path_def)
  with S,kind  (m#ms,s) =asτ (m'#ms',s') ‹length ms = length ms' 
  show ?thesis by(auto elim!:slpa_silent_moves_callstacks_eq 
    simp:targetnodes_def valid_call_list_def valid_return_list_def)
qed


lemma silent_moves_call_edge:
  assumes "S,kind  (m#ms,s) =asτ (m'#ms',s')" and "valid_node m"
  and callstack:"mx  set ms. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG"
  and rest:"i < length rs. rs!i  get_return_edges (cs!i)"
  "ms = targetnodes rs" "valid_return_list rs m" "length rs = length cs"
  obtains as' a as'' where "as = as'@a#as''" and "Q r p fs. kind a = Q:rpfs"
  and "call_of_return_node (hd ms') (sourcenode a)"
  and "targetnode a -as''sl* m'"
  | "ms' = ms"
proof(atomize_elim)
  from S,kind  (m#ms,s) =asτ (m'#ms',s')
  show "(as' a as''. as = as' @ a # as''  (Q r p fs. kind a = Q:rpfs) 
    call_of_return_node (hd ms') (sourcenode a)  targetnode a -as''sl* m') 
    ms' = ms"
  proof(induct as arbitrary:m' ms' s' rule:length_induct)
    fix as m' ms' s'
    assume IH:"as'. length as' < length as 
      (mx msx sx. S,kind  (m#ms,s) =as'τ (mx#msx,sx)  
      (asx a asx'. as' = asx @ a # asx'  (Q r p fs. kind a = Q:rpfs) 
      call_of_return_node (hd msx) (sourcenode a)  targetnode a -asx'sl* mx) 
      msx = ms)"
      and "S,kind  (m#ms,s) =asτ (m'#ms',s')"
    show "(as' a as''. as = as' @ a # as''  (Q r p fs. kind a = Q:rpfs) 
      call_of_return_node (hd ms') (sourcenode a)  targetnode a -as''sl* m') 
      ms' = ms"
    proof(cases as rule:rev_cases)
      case Nil
      with S,kind  (m#ms,s) =asτ (m'#ms',s') have "ms = ms'"
        by(fastforce elim:silent_moves.cases)
      thus ?thesis by simp
    next
      case (snoc as' a')
      with S,kind  (m#ms,s) =asτ (m'#ms',s')
      obtain ms'' s'' where "S,kind  (m#ms,s) =as'τ (ms'',s'')"
        and "S,kind  (ms'',s'') =[a']τ (m'#ms',s')"
        by(fastforce elim:silent_moves_split)
      from snoc have "length as' < length as" by simp
      from S,kind  (ms'',s'') =[a']τ (m'#ms',s')
      have "S,kind  (ms'',s'') -a'τ (m'#ms',s')"
        by(fastforce elim:silent_moves.cases)
      show ?thesis
      proof(cases "kind a'" rule:edge_kind_cases)
        case Intra
        with S,kind  (ms'',s'') -a'τ (m'#ms',s')
        have "valid_edge a'" and "m' = targetnode a'"
          by(auto elim:silent_move.cases simp:intra_kind_def)
        from S,kind  (ms'',s'') -a'τ (m'#ms',s') ‹intra_kind (kind a')
        have "ms'' = sourcenode a'#ms'"
          by -(erule silent_move.cases,auto simp:intra_kind_def,(cases ms'',auto)+)
        with IH ‹length as' < length as S,kind  (m#ms,s) =as'τ (ms'',s'')
        have "(asx ax asx'. as' = asx @ ax # asx'  (Q r p fs. kind ax = Q:rpfs) 
          call_of_return_node (hd ms') (sourcenode ax)  
          targetnode ax -asx'sl* sourcenode a')  ms' = ms"
          by simp blast
        thus ?thesis
        proof
          assume "asx ax asx'. as' = asx @ ax # asx'  
            (Q r p fs. kind ax = Q:rpfs) 
            call_of_return_node (hd ms') (sourcenode ax)  
            targetnode ax -asx'sl* sourcenode a'"
          then obtain asx ax asx' where "as' = asx @ ax # asx'"
            and "Q r p fs. kind ax = Q:rpfs"
            and "call_of_return_node (hd ms') (sourcenode ax)"
            and "targetnode ax -asx'sl* sourcenode a'"
            by blast
          from as' = asx @ ax # asx' have "as'@[a'] = asx @ ax # (asx' @ [a'])"
            by simp
          moreover
          from targetnode ax -asx'sl* sourcenode a' ‹intra_kind (kind a') 
            m' = targetnode a' valid_edge a'
          have "targetnode ax -asx'@[a']sl* m'"
            by(fastforce intro:path_Append path_edge same_level_path_aux_Append 
              upd_cs_Append simp:slp_def same_level_path_def intra_kind_def)
          ultimately show ?thesis using Q r p fs. kind ax = Q:rpfs 
            ‹call_of_return_node (hd ms') (sourcenode ax) snoc by blast
        next
          assume "ms' = ms" thus ?thesis by simp
        qed
      next
        case (Call Q r p fs)
        with S,kind  (ms'',s'') -a'τ (m'#ms',s') obtain a''
          where "valid_edge a'" and "a''  get_return_edges a'"
          and "hd ms'' = sourcenode a'" and "m' = targetnode a'"
          and "ms' = (targetnode a'')#tl ms''" and "length ms'' = length s''"
          and "pred (kind a') s''"
          by(auto elim:silent_move.cases simp:intra_kind_def)
        from valid_edge a' a''  get_return_edges a' have "valid_edge a''"
          by(rule get_return_edges_valid)
        from valid_edge a'' valid_edge a' a''  get_return_edges a'
        have "return_node (targetnode a'')" by(fastforce simp:return_node_def)
        with valid_edge a' valid_edge a''
          a''  get_return_edges a' ms' = (targetnode a'')#tl ms''
        have "call_of_return_node (hd ms') (sourcenode a')"
          by(simp add:call_of_return_node_def) blast
        with snoc kind a' = Q:rpfs m' = targetnode a' valid_edge a'
        show ?thesis by(fastforce intro:empty_path simp:slp_def same_level_path_def)
      next
        case (Return Q p f)
        with S,kind  (ms'',s'') -a'τ (m'#ms',s') 
        have "valid_edge a'" and "hd ms'' = sourcenode a'"
          and "hd(tl ms'') = targetnode a'" and "m'#ms' = tl ms''"
          and "length ms'' = length s''" and "length s'' = Suc(length s')"
          and "s'  []"
          by(auto elim:silent_move.cases simp:intra_kind_def)
        hence "ms'' = sourcenode a' # targetnode a' # ms'" by(cases ms'') auto
        with ‹length as' < length as S,kind  (m#ms,s) =as'τ (ms'',s'') IH
        have "(asx ax asx'. as' = asx @ ax # asx'  (Q r p fs. kind ax = Q:rpfs) 
          call_of_return_node (targetnode a') (sourcenode ax) 
          targetnode ax -asx'sl* sourcenode a')  ms = targetnode a' # ms'"
          apply - apply(erule_tac x="as'" in allE) apply clarsimp
          apply(erule_tac x="sourcenode a'" in allE)
          apply(erule_tac x="targetnode a' # ms'" in allE)
          by fastforce
        thus ?thesis
        proof
          assume "asx ax asx'. as' = asx @ ax # asx'  
            (Q r p fs. kind ax = Q:rpfs) 
            call_of_return_node (targetnode a') (sourcenode ax) 
            targetnode ax -asx'sl* sourcenode a'"
          then obtain asx ax asx' where "as' = asx @ ax # asx'"
            and "Q r p fs. kind ax = Q:rpfs" 
            and "call_of_return_node (targetnode a') (sourcenode ax)"
            and "targetnode ax -asx'sl* sourcenode a'" by blast
          from as' = asx @ ax # asx' snoc have"length asx < length as" by simp
          moreover
          from S,kind  (m#ms,s) =asτ (m'#ms',s') snoc as' = asx @ ax # asx'
          obtain msx sx where "S,kind  (m#ms,s) =asxτ (msx,sx)"
            and "S,kind  (msx,sx) =ax#asx'@[a']τ (m'#ms',s')"
            by(fastforce elim:silent_moves_split)
          from S,kind  (msx,sx) =ax#asx'@[a']τ (m'#ms',s')
          obtain xs x ys y where "S,kind  (msx,sx) -axτ (xs,x)"
            and "S,kind  (xs,x) =asx'τ (ys,y)"
            and "S,kind  (ys,y) =[a']τ (m'#ms',s')"
            apply - apply(erule silent_moves.cases) apply auto
            by(erule silent_moves_split) auto
          from S,kind  (msx,sx) -axτ (xs,x) Q r p fs. kind ax = Q:rpfs
          obtain msx' ax' where "msx = sourcenode ax#msx'" 
            and "ax'  get_return_edges ax"
            and [simp]:"xs = (targetnode ax)#(targetnode ax')#msx'"
            and "length x = Suc(length sx)" and "length msx = length sx"
            apply - apply(erule silent_move.cases) apply(auto simp:intra_kind_def)
            by(cases msx,auto)+
          from S,kind  (ys,y) =[a']τ (m'#ms',s') obtain msy 
            where "ys = sourcenode a'#msy"
            apply - apply(erule silent_moves.cases) apply auto
            apply(erule silent_move.cases)
            by(cases ys,auto)+
          with S,kind  (xs,x) =asx'τ (ys,y) 
            targetnode ax -asx'sl* sourcenode a'
            xs = (targetnode ax)#(targetnode ax')#msx'
          have "(targetnode ax')#msx' = msy" apply simp
            by(fastforce intro:silent_moves_same_level_path)
          with S,kind  (ys,y) =[a']τ (m'#ms',s') kind a' = Qpf 
            ys = sourcenode a'#msy
          have "m' = targetnode a'" and "msx' = ms'"
            by(fastforce elim:silent_moves.cases silent_move.cases 
                        simp:intra_kind_def)+
          with S,kind  (m#ms,s) =asxτ (msx,sx) msx = sourcenode ax#msx'
          have "S,kind  (m#ms,s) =asxτ (sourcenode ax#ms',sx)" by simp
          ultimately have "(xs x xs'. asx = xs@x#xs'  
            (Q r p fs. kind x = Q:rpfs) 
            call_of_return_node (hd ms') (sourcenode x) 
            targetnode x -xs'sl* sourcenode ax)  ms = ms'" using IH
            by simp blast
          thus ?thesis
          proof
            assume "xs x xs'. asx = xs@x#xs'  (Q r p fs. kind x = Q:rpfs) 
              call_of_return_node (hd ms') (sourcenode x) 
              targetnode x -xs'sl* sourcenode ax"
            then obtain xs x xs' where "asx = xs@x#xs'"
              and "Q r p fs. kind x = Q:rpfs" 
              and "call_of_return_node (hd ms') (sourcenode x)"
              and "targetnode x -xs'sl* sourcenode ax" by blast
            from asx = xs@x#xs' as' = asx @ ax # asx' snoc
            have "as = xs@x#(xs'@ax#asx'@[a'])" by simp
            from S,kind  (m#ms,s) =asτ (m'#ms',s') ‹valid_node m rest
            have "m -as→* m'" and "valid_path_aux cs as"
              by(auto dest:silent_moves_vpa_path[of _ _ _ _ _ _ _ _ _ rs cs]
                      simp:valid_call_list_def valid_return_list_def targetnodes_def)
            hence "m -as* m'" 
              by(fastforce intro:valid_path_aux_valid_path simp:vp_def)
            with snoc have "m -as'* sourcenode a'"
              by(auto elim:path_split_snoc dest:valid_path_aux_split 
                simp:vp_def valid_path_def)
            with as' = asx @ ax # asx'
            have "valid_edge ax" and "targetnode ax -asx'→* sourcenode a'"
              by(auto dest:path_split simp:vp_def)
            hence "sourcenode ax -ax#asx'→* sourcenode a'"
              by(fastforce intro:Cons_path)
            from valid_edge a' have "sourcenode a' -[a']→* targetnode a'"
              by(rule path_edge)
            with sourcenode ax -ax#asx'→* sourcenode a'
            have "sourcenode ax -(ax#asx')@[a']→* targetnode a'"
              by(rule path_Append)
            from m -as* m' snoc as' = asx @ ax # asx' snoc
            have "valid_path_aux ([]@(upd_cs [] asx)) (ax # asx' @ [a'])"
              by(fastforce dest:valid_path_aux_split simp:vp_def valid_path_def)
            hence "valid_path_aux [] (ax#asx'@[a'])" 
              by(rule valid_path_aux_callstack_prefix)
            with Q r p fs. kind ax = Q:rpfs
            have "valid_path_aux [ax] (asx'@[a'])" by fastforce
            hence "valid_path_aux (upd_cs [ax] asx') [a']"
              by(rule valid_path_aux_split)
            from targetnode ax -asx'sl* sourcenode a'
            have "same_level_path_aux [] asx'" and "upd_cs [] asx' = []" 
              by(simp_all add:slp_def same_level_path_def)
            hence "upd_cs ([]@[ax]) asx' = []@[ax]"
              by(rule same_level_path_upd_cs_callstack_Append)
            with ‹valid_path_aux (upd_cs [ax] asx') [a']
            have "valid_path_aux [ax] [a']" by(simp del:valid_path_aux.simps)
            with Q r p fs. kind ax = Q:rpfs kind a' = Qpf
            have "a'  get_return_edges ax" by simp
            with ‹upd_cs ([]@[ax]) asx' = []@[ax] kind a' = Qpf
            have "upd_cs [ax] (asx'@[a']) = []" by(fastforce intro:upd_cs_Append)
            with Q r p fs. kind ax = Q:rpfs
            have "upd_cs [] (ax#asx'@[a']) = []" by fastforce
            from targetnode ax -asx'sl* sourcenode a'
            have "same_level_path_aux [] asx'" and "upd_cs [] asx' = []" 
              by(simp_all add:slp_def same_level_path_def)
            hence "same_level_path_aux ([]@[ax]) asx'" 
              by -(rule same_level_path_aux_callstack_Append)
            with Q r p fs. kind ax = Q:rpfs kind a' = Qpf 
              a'  get_return_edges ax ‹upd_cs ([]@[ax]) asx' = []@[ax]
            have "same_level_path_aux [] ((ax#asx')@[a'])"
              by(fastforce intro:same_level_path_aux_Append)
            with ‹upd_cs [] (ax#asx'@[a']) = []
              sourcenode ax -(ax#asx')@[a']→* targetnode a'
            have "sourcenode ax -(ax#asx')@[a']sl* targetnode a'"
              by(simp add:slp_def same_level_path_def)
            with targetnode x -xs'sl* sourcenode ax
            have "targetnode x -xs'@((ax#asx')@[a'])sl* targetnode a'"
              by(rule slp_Append)
            with Q r p fs. kind x = Q:rpfs 
              ‹call_of_return_node (hd ms') (sourcenode x)
              as = xs@x#(xs'@ax#asx'@[a']) m' = targetnode a'
            show ?thesis by simp blast
          next
            assume "ms = ms'" thus ?thesis by simp
          qed
        next
          assume "ms = targetnode a' # ms'"
          from S,kind  (ms'',s'') -a'τ (m'#ms',s') kind a' = Qpf
            ms'' = sourcenode a' # targetnode a' # ms'
          have "m  set (targetnode a' # ms'). m'. call_of_return_node m m'  
            m'  HRB_slice SCFG"
            by(fastforce elim!:silent_move.cases simp:intra_kind_def)
          with ms = targetnode a' # ms' callstack
          have False by fastforce
          thus ?thesis by simp
        qed
      qed
    qed
  qed
qed


lemma silent_moves_called_node_in_slice1_hd_nodestack_in_slice1:
  assumes "S,kind  (m#ms,s) =asτ (m'#ms',s')" and "valid_node m"
  and "CFG_node m'  sum_SDG_slice1 nx"
  and "mx  set ms. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG"
  and "i < length rs. rs!i  get_return_edges (cs!i)" and "ms = targetnodes rs"
  and "valid_return_list rs m" and "length rs = length cs"
  obtains as' a as'' where "as = as'@a#as''" and "Q r p fs. kind a = Q:rpfs"
  and "call_of_return_node (hd ms') (sourcenode a)"
  and "targetnode a -as''sl* m'" and "CFG_node (sourcenode a)  sum_SDG_slice1 nx"
  | "ms' = ms"
proof(atomize_elim)
  from S,kind  (m#ms,s) =asτ (m'#ms',s') ‹valid_node m
    i < length rs. rs!i  get_return_edges (cs!i) ms = targetnodes rs
    ‹valid_return_list rs m ‹length rs = length cs
  have "m -as→* m'"
    by(auto dest:silent_moves_vpa_path[of _ _ _ _ _ _ _ _ _ rs cs]
            simp:valid_call_list_def valid_return_list_def targetnodes_def)
  from S,kind  (m#ms,s) =asτ (m'#ms',s') ‹valid_node m
    mx  set ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
    i < length rs. rs!i  get_return_edges (cs!i) ms = targetnodes rs
    ‹valid_return_list rs m ‹length rs = length cs
  show "(as' a as''. as = as' @ a # as''  (Q r p fs. kind a = Q:rpfs) 
    call_of_return_node (hd ms') (sourcenode a)  targetnode a -as''sl* m' 
    CFG_node (sourcenode a)  sum_SDG_slice1 nx)  ms' = ms"
  proof(rule silent_moves_call_edge)
    fix as' a as'' assume "as = as'@a#as''" and "Q r p fs. kind a = Q:rpfs"
      and "call_of_return_node (hd ms') (sourcenode a)"
      and "targetnode a -as''sl* m'"
    from Q r p fs. kind a = Q:rpfs obtain Q r p fs 
      where "kind a = Q:rpfs" by blast
    from targetnode a -as''sl* m' obtain asx where "targetnode a -asxι* m'"
      by -(erule same_level_path_inner_path)
    from m -as→* m' as = as'@a#as'' have "valid_edge a"
      by(fastforce dest:path_split simp:vp_def)
    have "m'  (_Exit_)"
    proof
      assume "m' = (_Exit_)"
      have "get_proc (_Exit_) = Main" by(rule get_proc_Exit)
      from targetnode a -asxι* m'
      have "get_proc (targetnode a) = get_proc m'" by(rule intra_path_get_procs)
      with m' = (_Exit_) get_proc (_Exit_) = Main
      have "get_proc (targetnode a) = Main" by simp
      with kind a = Q:rpfs valid_edge a
      have "kind a = Q:rMainfs" by(fastforce dest:get_proc_call)
      with valid_edge a show False by(rule Main_no_call_target)
    qed
    show ?thesis
    proof(cases "targetnode a = m'")
      case True
      with valid_edge a kind a = Q:rpfs
      have "CFG_node (sourcenode a) s-pcall CFG_node m'"
        by(fastforce intro:sum_SDG_call_edge)
      with ‹CFG_node m'  sum_SDG_slice1 nx
      have "CFG_node (sourcenode a)  sum_SDG_slice1 nx" by -(rule call_slice1)
      with as = as'@a#as'' Q r p fs. kind a = Q:rpfs
        ‹call_of_return_node (hd ms') (sourcenode a)
        targetnode a -as''sl* m' show ?thesis by blast
    next
      case False
      with targetnode a -asxι* m' m'  (_Exit_) valid_edge a kind a = Q:rpfs
      obtain ns where "CFG_node (targetnode a) cd-nsd* CFG_node m'"
        by(fastforce elim!:in_proc_cdep_SDG_path)
      hence "CFG_node (targetnode a) is-nsd* CFG_node m'"
        by(fastforce intro:intra_SDG_path_is_SDG_path cdep_SDG_path_intra_SDG_path)
      with ‹CFG_node m'  sum_SDG_slice1 nx
      have "CFG_node (targetnode a)  sum_SDG_slice1 nx"
        by -(rule is_SDG_path_slice1)
      from valid_edge a kind a = Q:rpfs
      have "CFG_node (sourcenode a) s-pcall CFG_node (targetnode a)"
        by(fastforce intro:sum_SDG_call_edge)
      with ‹CFG_node (targetnode a)  sum_SDG_slice1 nx
      have "CFG_node (sourcenode a)  sum_SDG_slice1 nx" by -(rule call_slice1)
      with as = as'@a#as'' Q r p fs. kind a = Q:rpfs
        ‹call_of_return_node (hd ms') (sourcenode a)
        targetnode a -as''sl* m' show ?thesis by blast
    qed
  next
    assume "ms' = ms" thus ?thesis by simp
  qed
qed


lemma silent_moves_called_node_in_slice1_nodestack_in_slice1:
  "S,kind  (m#ms,s) =asτ (m'#ms',s'); valid_node m; 
   CFG_node m'  sum_SDG_slice1 nx; nx  S;
   mx  set ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG;
   i < length rs. rs!i  get_return_edges (cs!i); ms = targetnodes rs;
   valid_return_list rs m; length rs = length cs
   mx  set ms'. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG"
proof(induct ms' arbitrary:as m' s')
  case (Cons mx msx)
  note IH = as m' s'. S,kind  (m#ms,s) =asτ (m' # msx,s'); valid_node m; 
    CFG_node m'  sum_SDG_slice1 nx; nx  S;
   mxset ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG;
   i<length rs. rs ! i  get_return_edges (cs ! i); ms = targetnodes rs;
   valid_return_list rs m; length rs = length cs
     mxset msx. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
  from S,kind  (m#ms,s) =asτ (m' # mx # msx,s') ‹valid_node m
    ‹CFG_node m'  sum_SDG_slice1 nx
    mx  set ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
    i < length rs. rs!i  get_return_edges (cs!i) ms = targetnodes rs
    ‹valid_return_list rs m ‹length rs = length cs
  show ?case
  proof(rule silent_moves_called_node_in_slice1_hd_nodestack_in_slice1)
    fix as' a as'' assume "as = as'@a#as''" and "Q r p fs. kind a = Q:rpfs"
      and "call_of_return_node (hd (mx # msx)) (sourcenode a)" 
      and "CFG_node (sourcenode a)  sum_SDG_slice1 nx"
      and "targetnode a -as''sl* m'"
    from ‹CFG_node (sourcenode a)  sum_SDG_slice1 nx nx  S
    have "sourcenode a  HRB_slice SCFG"
      by(fastforce intro:combSlice_refl simp:SDG_to_CFG_set_def HRB_slice_def)
    from S,kind  (m#ms,s) =asτ (m' # mx # msx,s') as = as'@a#as''
    obtain xs x where "S,kind  (m#ms,s) =as'τ (xs,x)"
      and "S,kind  (xs,x) =a#as''τ (m' # mx # msx,s')"
      by(fastforce elim:silent_moves_split)
    from S,kind  (xs,x) =a#as''τ (m' # mx # msx,s')
    obtain ys y where "S,kind  (xs,x) -aτ (ys,y)"
      and "S,kind  (ys,y) =as''τ (m' # mx # msx,s')"
      by(fastforce elim:silent_moves.cases)
    from S,kind  (xs,x) -aτ (ys,y) Q r p fs. kind a = Q:rpfs
    obtain xs' a' where "xs = sourcenode a#xs'" 
      and "ys = targetnode a#targetnode a'#xs'"
      apply - apply(erule silent_move.cases) apply(auto simp:intra_kind_def)
      by(cases xs,auto)+
    from S,kind  (ys,y) =as''τ (m' # mx # msx,s') 
      ys = targetnode a#targetnode a'#xs' targetnode a -as''sl* m'
    have "mx = targetnode a'" and "xs' = msx" 
      by(auto dest:silent_moves_same_level_path)
    with xs = sourcenode a#xs' S,kind  (m#ms,s) =as'τ (xs,x)
    have "S,kind  (m#ms,s) =as'τ (sourcenode a#msx,x)" by simp
    from IH[OF S,kind  (m#ms,s) =as'τ (sourcenode a#msx,x) 
      ‹valid_node m ‹CFG_node (sourcenode a)  sum_SDG_slice1 nx nx  S
      mx  set ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
      i < length rs. rs!i  get_return_edges (cs!i) ms = targetnodes rs
      ‹valid_return_list rs m ‹length rs = length cs]
    have callstack:"mxset msx.
      mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG" .
    with as = as'@a#as'' ‹call_of_return_node (hd (mx # msx)) (sourcenode a) 
      sourcenode a  HRB_slice SCFG show ?thesis by fastforce
  next
    assume "mx # msx = ms"
    with mx  set ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
    show ?thesis by fastforce
  qed
qed simp


lemma silent_moves_slice_intra_path:
  assumes "S,slice_kind S  (m#ms,s) =asτ (m'#ms',s')"
  and "mx  set ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG"
  shows "a  set as. intra_kind (kind a)"
proof(rule ccontr)
  assume "¬ (aset as. intra_kind (kind a))"
  hence "a  set as. ¬ intra_kind (kind a)" by fastforce
  then obtain asx ax asx' where "as = asx@ax#asx'" 
    and "aset asx. intra_kind (kind a)" and "¬ intra_kind (kind ax)"
    by(fastforce elim!:split_list_first_propE)
  from S,slice_kind S  (m#ms,s) =asτ (m'#ms',s') as = asx@ax#asx'
  obtain msx sx msx' sx' where "S,slice_kind S  (m#ms,s) =asxτ (msx,sx)"
    and "S,slice_kind S  (msx,sx) -axτ (msx',sx')"
    and "S,slice_kind S  (msx',sx') =asx'τ (m'#ms',s')"
    by(auto elim!:silent_moves_split elim:silent_moves.cases)
  from S,slice_kind S  (msx,sx) -axτ (msx',sx') obtain xs
    where [simp]:"msx = sourcenode ax#xs" by(cases msx)(auto elim:silent_move.cases)
  from S,slice_kind S  (m#ms,s) =asxτ (msx,sx) aset asx. intra_kind (kind a)
  have [simp]:"xs = ms" by(fastforce dest:silent_moves_intra_path)
  show False
  proof(cases "kind ax" rule:edge_kind_cases)
    case Intra with ¬ intra_kind (kind ax) show False by simp
  next
    case (Call Q r p fs)
    with S,slice_kind S  (msx,sx) -axτ (msx',sx') 
      mx  set ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
    have "sourcenode ax  HRB_slice SCFG" and "pred (slice_kind S ax) sx"
      by(auto elim!:silent_move.cases simp:intra_kind_def)
    from sourcenode ax  HRB_slice SCFG kind ax = Q:rpfs
    have "slice_kind S ax = (λcf. False):rpfs"
      by(rule slice_kind_Call)
    with ‹pred (slice_kind S ax) sx show False by(cases sx) auto
  next
    case (Return Q p f)
    with S,slice_kind S  (msx,sx) -axτ (msx',sx') 
      mx  set ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
    show False by(fastforce elim!:silent_move.cases simp:intra_kind_def)
  qed
qed


lemma silent_moves_slice_keeps_state:
  assumes "S,slice_kind S  (m#ms,s) =asτ (m'#ms',s')"
  and "mx  set ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG"
  shows "s = s'"
proof -
  from assms have "a  set as. intra_kind (kind a)"
    by(rule silent_moves_slice_intra_path)
  with assms show ?thesis
  proof(induct S "slice_kind S" "m#ms" s as "m'#ms'" s'
        arbitrary:m rule:silent_moves.induct)
    case (silent_moves_Nil sx nc) thus ?case by simp
  next
    case (silent_moves_Cons S sx a msx' sx' as s'')
    note IH = m.
      msx' = m # ms;
      mxset ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG;
      aset as. intra_kind (kind a)  sx' = s''
    note callstack = mxset ms. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG
    from aset (a # as). intra_kind (kind a) have "intra_kind (kind a)"
      and "aset as. intra_kind (kind a)" by simp_all
    from S,slice_kind S  (m # ms,sx) -aτ (msx',sx') ‹intra_kind (kind a)
      callstack
    have [simp]:"msx' = targetnode a#ms" and "sx' = transfer (slice_kind S a) sx"
      and "sourcenode a  HRB_slice SCFG" and "valid_edge a" and "sx  []"
      by(auto elim!:silent_move.cases simp:intra_kind_def)
    from IH[OF msx' = targetnode a#ms callstack aset as. intra_kind (kind a)]
    have "sx' = s''" .
    from ‹intra_kind (kind a)
    have "sx = sx'"
    proof(cases "kind a")
      case (UpdateEdge f')
      with sourcenode a  HRB_slice SCFG
      have "slice_kind S a = id" by(rule slice_kind_Upd)
      with sx' = transfer (slice_kind S a) sx sx  []
      show ?thesis by(cases sx) auto
    next
      case (PredicateEdge Q)
      with sourcenode a  HRB_slice SCFG valid_edge a
      obtain Q' where "slice_kind S a = (Q')"
        by -(erule kind_Predicate_notin_slice_slice_kind_Predicate)
      with sx' = transfer (slice_kind S a) sx sx  []
      show ?thesis by(cases sx) auto
    qed (auto simp:intra_kind_def)
    with sx' = s'' show ?case by simp
  qed
qed


subsection ‹Definition of slice_edges›

definition slice_edge :: "'node SDG_node set  'edge list  'edge  bool"
where "slice_edge S cs a  (c  set cs. sourcenode c  HRB_slice SCFG) 
  (case (kind a) of Qpf  True | _  sourcenode a  HRB_slice SCFG)"


lemma silent_move_no_slice_edge:
  "S,f  (ms,s) -aτ (ms',s'); tl ms = targetnodes rs; length rs = length cs;
    i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))
   ¬ slice_edge S cs a"
proof(induct rule:silent_move.induct)
  case (silent_move_intra f a s s' ms S ms')
  note disj = (mset (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG)
     hd ms  HRB_slice SCFG
  from ‹pred (f a) s ‹length ms = length s obtain x xs where "ms = x#xs"
    by(cases ms) auto
  from ‹length rs = length cs ‹tl ms = targetnodes rs
  have "length (tl ms) = length cs" by(simp add:targetnodes_def)
  from disj show ?case
  proof
    assume "mset (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG"
    with i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))
      ‹length (tl ms) = length cs
    have "c  set cs. sourcenode c  HRB_slice SCFG"
      apply(auto simp:in_set_conv_nth)
      by(erule_tac x="i" in allE) auto
    thus ?thesis by(auto simp:slice_edge_def)
  next
    assume "hd ms  HRB_slice SCFG"
    with ‹hd ms = sourcenode a ‹intra_kind (kind a)
    show ?case by(auto simp:slice_edge_def simp:intra_kind_def)
  qed
next
  case (silent_move_call f a s s' Q r p fs a' ms S ms')
  note disj = (mset (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG)
     hd ms  HRB_slice SCFG
  from ‹pred (f a) s ‹length ms = length s obtain x xs where "ms = x#xs"
    by(cases ms) auto
  from ‹length rs = length cs ‹tl ms = targetnodes rs
  have "length (tl ms) = length cs" by(simp add:targetnodes_def)
  from disj show ?case
  proof
    assume "mset (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG"
    with i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))
      ‹length (tl ms) = length cs
    have "c  set cs. sourcenode c  HRB_slice SCFG"
      apply(auto simp:in_set_conv_nth)
      by(erule_tac x="i" in allE) auto
    thus ?thesis by(auto simp:slice_edge_def)
  next
    assume "hd ms  HRB_slice SCFG"
    with ‹hd ms = sourcenode a kind a = Q:rpfs
    show ?case by(auto simp:slice_edge_def)
  qed
next
  case (silent_move_return f a s s' Q p f' ms S ms')
  from ‹pred (f a) s ‹length ms = length s obtain x xs where "ms = x#xs"
    by(cases ms) auto
  from ‹length rs = length cs ‹tl ms = targetnodes rs
  have "length (tl ms) = length cs" by(simp add:targetnodes_def)
  from i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))
    mset (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG
    ‹length (tl ms) = length cs
  have "c  set cs. sourcenode c  HRB_slice SCFG"
    apply(auto simp:in_set_conv_nth)
    by(erule_tac x="i" in allE) auto
  thus ?case by(auto simp:slice_edge_def)
qed


lemma observable_move_slice_edge:
  "S,f  (ms,s) -a (ms',s'); tl ms = targetnodes rs; length rs = length cs;
    i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))
   slice_edge S cs a"
proof(induct rule:observable_move.induct)
  case (observable_move_intra f a s s' ms S ms')
  from ‹pred (f a) s ‹length ms = length s obtain x xs where "ms = x#xs"
    by(cases ms) auto
  from ‹length rs = length cs ‹tl ms = targetnodes rs
  have "length (tl ms) = length cs" by(simp add:targetnodes_def)
  with mset (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG
    i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))
  have "c  set cs. sourcenode c  HRB_slice SCFG"
    apply(auto simp:in_set_conv_nth)
    by(erule_tac x="i" in allE) auto
  with ‹hd ms = sourcenode a ‹hd ms  HRB_slice SCFG ‹intra_kind (kind a)
  show ?case by(auto simp:slice_edge_def simp:intra_kind_def)
next
  case (observable_move_call f a s s' Q r p fs a' ms S ms')
  from ‹pred (f a) s ‹length ms = length s obtain x xs where "ms = x#xs"
    by(cases ms) auto
  from ‹length rs = length cs ‹tl ms = targetnodes rs
  have "length (tl ms) = length cs" by(simp add:targetnodes_def)
  with mset (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG
    i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))
  have "c  set cs. sourcenode c  HRB_slice SCFG"
    apply(auto simp:in_set_conv_nth)
    by(erule_tac x="i" in allE) auto
  with ‹hd ms = sourcenode a ‹hd ms  HRB_slice SCFG kind a = Q:rpfs
  show ?case by(auto simp:slice_edge_def)
next
  case (observable_move_return f a s s' Q p f' ms S ms')
  from ‹pred (f a) s ‹length ms = length s obtain x xs where "ms = x#xs"
    by(cases ms) auto
  from ‹length rs = length cs ‹tl ms = targetnodes rs
  have "length (tl ms) = length cs" by(simp add:targetnodes_def)
  with mset (tl ms). m'. call_of_return_node m m'  m'  HRB_slice SCFG
    i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))
  have "c  set cs. sourcenode c  HRB_slice SCFG"
    apply(auto simp:in_set_conv_nth)
    by(erule_tac x="i" in allE) auto
  with kind a = Qpf' show ?case by(auto simp:slice_edge_def)
qed



function slice_edges :: "'node SDG_node set  'edge list  'edge list  'edge list"
where "slice_edges S cs [] = []"
  | "slice_edge S cs a  
     slice_edges S cs (a#as) = a#slice_edges S (upd_cs cs [a]) as"
  | "¬ slice_edge S cs a  
     slice_edges S cs (a#as) = slice_edges S (upd_cs cs [a]) as"
by(atomize_elim)(auto,case_tac b,auto)
termination by(lexicographic_order)


lemma slice_edges_Append:
  "slice_edges S cs as = as'; slice_edges S (upd_cs cs as) asx = asx'
   slice_edges S cs (as@asx) = as'@asx'"
proof(induct as arbitrary:cs as')
  case Nil thus ?case by simp
next
  case (Cons x xs)
  note IH = cs as'. slice_edges S cs xs = as'; 
    slice_edges S (upd_cs cs xs) asx = asx'
     slice_edges S cs (xs @ asx) = as' @ asx'
  from ‹slice_edges S (upd_cs cs (x # xs)) asx = asx' 
  have "slice_edges S (upd_cs (upd_cs cs [x]) xs) asx = asx'"
    by(cases "kind x")(auto,cases cs,auto)
  show ?case
  proof(cases "slice_edge S cs x")
    case True
    with ‹slice_edges S cs (x # xs) = as'
    have "x#slice_edges S (upd_cs cs [x]) xs = as'" by simp
    then obtain xs' where "as' = x#xs'"
      and "slice_edges S (upd_cs cs [x]) xs = xs'" by(cases as') auto
    from IH[OF ‹slice_edges S (upd_cs cs [x]) xs = xs'
      ‹slice_edges S (upd_cs (upd_cs cs [x]) xs) asx = asx']
    have "slice_edges S (upd_cs cs [x]) (xs @ asx) = xs' @ asx'" .
    with True as' = x#xs' show ?thesis by simp
  next
    case False
    with ‹slice_edges S cs (x # xs) = as'
    have "slice_edges S (upd_cs cs [x]) xs = as'" by simp
    from IH[OF this ‹slice_edges S (upd_cs (upd_cs cs [x]) xs) asx = asx']
    have "slice_edges S (upd_cs cs [x]) (xs @ asx) = as' @ asx'" .
    with False show ?thesis by simp
  qed
qed


lemma slice_edges_Nil_split:
  "slice_edges S cs (as@as') = []
   slice_edges S cs as = []  slice_edges S (upd_cs cs as) as' = []"
apply(induct as arbitrary:cs)
 apply clarsimp
apply(case_tac "slice_edge S cs a") apply auto
apply(case_tac "kind a") apply auto
apply(case_tac cs) apply auto
done


lemma slice_intra_edges_no_nodes_in_slice:
  "slice_edges S cs as = []; a  set as. intra_kind (kind a);
    c  set cs. sourcenode c  HRB_slice SCFG
   nx  set(sourcenodes as). nx  HRB_slice SCFG"
proof(induct as)
  case Nil thus ?case by(fastforce simp:sourcenodes_def)
next
  case (Cons a' as')
  note IH = slice_edges S cs as' = []; aset as'. intra_kind (kind a);
    cset cs. sourcenode c  HRB_slice SCFG
     nxset (sourcenodes as'). nx  HRB_slice SCFG
  from aset (a' # as'). intra_kind (kind a)
  have "intra_kind (kind a')" and "aset as'. intra_kind (kind a)" by simp_all
  from ‹slice_edges S cs (a' # as') = [] ‹intra_kind (kind a')
    cset cs. sourcenode c  HRB_slice SCFG
  have "sourcenode a'  HRB_slice SCFG" and "slice_edges S cs as' = []"
    by(cases "slice_edge S cs a'",auto simp:intra_kind_def slice_edge_def)+
  from IH[OF ‹slice_edges S cs as' = [] aset as'. intra_kind (kind a)
    cset cs. sourcenode c  HRB_slice SCFG] 
  have "nxset (sourcenodes as'). nx  HRB_slice SCFG" .
  with sourcenode a'  HRB_slice SCFG show ?case by(simp add:sourcenodes_def)
qed


lemma silent_moves_no_slice_edges:
  "S,f  (ms,s) =asτ (ms',s'); tl ms = targetnodes rs; length rs = length cs;
    i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))
   slice_edges S cs as = []  (rs'. tl ms' = targetnodes rs' 
  length rs' = length (upd_cs cs as)  (i<length (upd_cs cs as). 
  call_of_return_node (tl ms'!i) (sourcenode ((upd_cs cs as)!i))))"
proof(induct arbitrary:rs cs rule:silent_moves.induct)
  case (silent_moves_Cons S f ms s a ms' s' as ms'' s'')
  from S,f  (ms,s) -aτ (ms',s') ‹tl ms = targetnodes rs ‹length rs = length cs
    i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))
  have "¬ slice_edge S cs a" by(rule silent_move_no_slice_edge)
  with silent_moves_Cons show ?case
  proof(induct rule:silent_move.induct)
    case (silent_move_intra f a s s' ms S ms')
    note IH = rs cs. tl ms' = targetnodes rs; length rs = length cs;
      i<length cs. call_of_return_node (tl ms' ! i) (sourcenode (cs ! i))
       slice_edges S cs as = []  (rs'. tl ms'' = targetnodes rs' 
      length rs' = length (upd_cs cs as)  (i<length (upd_cs cs as).
      call_of_return_node (tl ms'' ! i) (sourcenode (upd_cs cs as ! i))))
    from ms' = targetnode a # tl ms ‹tl ms = targetnodes rs
    have "tl ms' = targetnodes rs" by simp
    from ms' = targetnode a # tl ms ‹tl ms = targetnodes rs
      i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))
    have "i<length cs. call_of_return_node (tl ms' ! i) (sourcenode (cs ! i))"
      by simp
    from IH[OF ‹tl ms' = targetnodes rs ‹length rs = length cs this]
    have "slice_edges S cs as = []" 
      and "rs'. tl ms'' = targetnodes rs'  length rs' = length (upd_cs cs as) 
      (i<length (upd_cs cs as). 
      call_of_return_node (tl ms'' ! i) (sourcenode (upd_cs cs as ! i)))" by simp_all
    with ‹intra_kind (kind a) ¬ slice_edge S cs a
    show ?case by(fastforce simp:intra_kind_def)
  next
    case (silent_move_call f a s s' Q r p fs a' ms S ms')
    note IH = rs cs. tl ms' = targetnodes rs; length rs = length cs;
      i<length cs. call_of_return_node (tl ms' ! i) (sourcenode (cs ! i))
       slice_edges S cs as = []  (rs'. tl ms'' = targetnodes rs' 
      length rs' = length (upd_cs cs as)  (i<length (upd_cs cs as).
      call_of_return_node (tl ms'' ! i) (sourcenode (upd_cs cs as ! i))))
    from ‹tl ms = targetnodes rs ms' = targetnode a # targetnode a' # tl ms
    have "tl ms' = targetnodes (a'#rs)" by(simp add:targetnodes_def)
    from ‹length rs = length cs have "length (a'#rs) = length (a#cs)" by simp
    from valid_edge a' valid_edge a a'  get_return_edges a
    have "return_node (targetnode a')" by(fastforce simp:return_node_def)
    with valid_edge a valid_edge a' a'  get_return_edges a
    have "call_of_return_node (targetnode a') (sourcenode a)"
      by(simp add:call_of_return_node_def) blast
    with i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))
      ms' = targetnode a # targetnode a' # tl ms
    have "i<length (a#cs). 
      call_of_return_node (tl ms' ! i) (sourcenode ((a#cs) ! i))"
      by auto (case_tac i,auto)
    from IH[OF ‹tl ms' = targetnodes (a'#rs) ‹length (a'#rs) = length (a#cs) this]
    have "slice_edges S (a # cs) as = []"
      and "rs'. tl ms'' = targetnodes rs' 
      length rs' = length (upd_cs (a # cs) as) 
      (i<length (upd_cs (a # cs) as).
        call_of_return_node (tl ms'' ! i) (sourcenode (upd_cs (a # cs) as ! i)))"
      by simp_all
    with ¬ slice_edge S cs a kind a = Q:rpfs show ?case by simp
  next
    case (silent_move_return f a s s' Q p f' ms S ms')
    note IH = rs cs. tl ms' = targetnodes rs; length rs = length cs;
      i<length cs. call_of_return_node (tl ms' ! i) (sourcenode (cs ! i))
       slice_edges S cs as = []  (rs'. tl ms'' = targetnodes rs' 
      length rs' = length (upd_cs cs as)  (i<length (upd_cs cs as).
      call_of_return_node (tl ms'' ! i) (sourcenode (upd_cs cs as ! i))))
    from ‹length s = Suc (length s') s'  [] ‹length ms = length s ms' = tl ms
    obtain x xs where [simp]:"ms' = x#xs" by(cases ms)(auto,case_tac ms',auto)
    from ms' = tl ms ‹tl ms = targetnodes rs obtain r' rs' where "rs = r'#rs'"
      and "x = targetnode r'" and "tl ms' = targetnodes rs'"
      by(cases rs)(auto simp:targetnodes_def)
    from ‹length rs = length cs rs = r'#rs' obtain c' cs' where "cs = c'#cs'"
      and "length rs' = length cs'" by(cases cs) auto
    from i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))
      cs = c'#cs' ms' = tl ms
    have "i<length cs'. call_of_return_node (tl ms' ! i) (sourcenode (cs' ! i))"
      by auto(erule_tac x="Suc i" in allE,cases "tl ms",auto)
    from IH[OF ‹tl ms' = targetnodes rs' ‹length rs' = length cs' this]
    have "slice_edges S cs' as = []" and "rs'. tl ms'' = targetnodes rs' 
      length rs' = length (upd_cs cs' as)  (i<length (upd_cs cs' as).
      call_of_return_node (tl ms'' ! i) (sourcenode (upd_cs cs' as ! i)))"
      by simp_all
    with ¬ slice_edge S cs a kind a = Qpf' cs = c'#cs'
    show ?case by simp
  qed
qed fastforce



lemma observable_moves_singular_slice_edge:
  "S,f  (ms,s) =as (ms',s'); tl ms = targetnodes rs; length rs = length cs;
    i<length cs. call_of_return_node (tl ms!i) (sourcenode (cs!i))
   slice_edges S cs as = [last as]"
proof(induct rule:observable_moves.induct)
  case (observable_moves_snoc S f ms s as ms' s' a ms'' s'')
  from S,f  (ms,s) =asτ (ms',s') ‹tl ms = targetnodes rs ‹length rs = length cs
    i<length cs. call_of_return_node (tl ms ! i) (sourcenode (cs ! i))
  obtain rs' where "slice_edges S cs as = []" 
    and "tl ms' = targetnodes rs'" and "length rs' = length (upd_cs cs as)"
    and "i<length (upd_cs cs as). 
    call_of_return_node (tl ms'!i) (sourcenode ((upd_cs cs as)!i))"
    by(fastforce dest!:silent_moves_no_slice_edges)
  from S,f  (ms',s') -a (ms'',s'') this
  have "slice_edge S (upd_cs cs as) a" by -(rule observable_move_slice_edge)
  with ‹slice_edges S cs as = [] have "slice_edges S cs (as @ [a]) = []@[a]"
    by(fastforce intro:slice_edges_Append)
  thus ?case by simp
qed


lemma silent_moves_nonempty_nodestack_False:
  assumes "S,kind  ([m],[cf]) =asτ (m'#ms',s')" and "valid_node m"
  and "ms'  []" and "CFG_node m'  sum_SDG_slice1 nx" and "nx  S"
  shows False
proof -
  from assms(1-4) have "slice_edges S [] as  []"
  proof(induct ms' arbitrary:as m' s')
    case (Cons mx msx)
    note IH = as m' s'. S,kind  ([m],[cf]) =asτ (m' # msx,s'); valid_node m; 
      msx  []; CFG_node m'  sum_SDG_slice1 nx
       slice_edges S [] as  []
    from S,kind  ([m],[cf]) =asτ (m' # mx # msx,s') ‹valid_node m
      ‹CFG_node m'  sum_SDG_slice1 nx
    obtain as' a as'' where "as = as'@a#as''" and "Q r p fs. kind a = Q:rpfs"
      and "call_of_return_node mx (sourcenode a)" 
      and "CFG_node (sourcenode a)  sum_SDG_slice1 nx"
      and "targetnode a -as''sl* m'"
      by(fastforce elim!:silent_moves_called_node_in_slice1_hd_nodestack_in_slice1
      [of _ _ _ _ _ _ _ _ _ "[]" "[]"] simp:targetnodes_def valid_return_list_def)
    from S,kind  ([m],[cf]) =asτ (m' # mx # msx,s') as = as'@a#as''
    obtain xs x where "S,kind  ([m],[cf]) =as'τ (xs,x)"
      and "S,kind  (xs,x) =a#as''τ (m' # mx # msx,s')"
      by(fastforce elim:silent_moves_split)
    from S,kind  (xs,x) =a#as''τ (m' # mx # msx,s')
    obtain ys y where "S,kind  (xs,x) -aτ (ys,y)"
      and "S,kind  (ys,y) =as''τ (m' # mx # msx,s')"
      by(fastforce elim:silent_moves.cases)
    from S,kind  (xs,x) -aτ (ys,y) Q r p fs. kind a = Q:rpfs
    obtain xs' a' where "xs = sourcenode a#xs'" 
      and "ys = targetnode a#targetnode a'#xs'"
      apply - apply(erule silent_move.cases) apply(auto simp:intra_kind_def)
      by(cases xs,auto)+
    from S,kind  (ys,y) =as''τ (m' # mx # msx,s') 
      ys = targetnode a#targetnode a'#xs' targetnode a -as''sl* m'
    have "mx = targetnode a'" and "xs' = msx"
      by(auto dest:silent_moves_same_level_path)
    with xs = sourcenode a#xs' S,kind  ([m],[cf]) =as'τ (xs,x)
    have "S,kind  ([m],[cf]) =as'τ (sourcenode a#msx,x)" by simp
    show ?case
    proof(cases "msx = []")
      case True
      from S,kind  ([m],[cf]) =as'τ (sourcenode a#msx,x)
      obtain rs' where "msx = targetnodes rs'  length rs' = length (upd_cs [] as')"
        by(fastforce dest!:silent_moves_no_slice_edges[where cs="[]" and rs="[]"]
                    simp:targetnodes_def)
      with True have "upd_cs [] as' = []"  by(cases rs')(auto simp:targetnodes_def)
      with ‹CFG_node (sourcenode a)  sum_SDG_slice1 nx nx  S
      have "slice_edge S (upd_cs [] as') a"
        by(cases "kind a",auto intro:combSlice_refl 
          simp:slice_edge_def SDG_to_CFG_set_def HRB_slice_def)
      hence "slice_edges S (upd_cs [] as') (a#as'')  []" by simp
      with as = as'@a#as'' show ?thesis by(fastforce dest:slice_edges_Nil_split)
    next
      case False
      from IH[OF S,kind  ([m],[cf]) =as'τ (sourcenode a#msx,x) 
        ‹valid_node m this ‹CFG_node (sourcenode a)  sum_SDG_slice1 nx]
      have "slice_edges S [] as'  []" .
      with as = as'@a#as'' show ?thesis by(fastforce dest:slice_edges_Nil_split)
    qed
  qed simp
  moreover
  from S,kind  ([m],[cf]) =asτ (m'#ms',s') have "slice_edges S [] as = []"
    by(fastforce dest!:silent_moves_no_slice_edges[where cs="[]" and rs="[]"] 
                simp:targetnodes_def)
  ultimately show False by simp
qed



lemma transfers_intra_slice_kinds_slice_edges:
  "a  set as. intra_kind (kind a); c  set cs. sourcenode c  HRB_slice SCFG
   transfers (slice_kinds S (slice_edges S cs as)) s =
  transfers (slice_kinds S as) s"
proof(induct as arbitrary:s)
  case Nil thus ?case by(simp add:slice_kinds_def)
next
  case (Cons a' as')
  note IH = s. aset as'. intra_kind (kind a);
    cset cs. sourcenode c  HRB_slice SCFG 
    transfers (slice_kinds S (slice_edges S cs as')) s =
    transfers (slice_kinds S as') s
  from aset (a' # as'). intra_kind (kind a)
  have "intra_kind (kind a')" and "aset as'. intra_kind (kind a)"
    by simp_all
  show ?case
  proof(cases "slice_edge S cs a'")
    case True
    with ‹intra_kind (kind a')
    have eq:"transfers (slice_kinds S (slice_edges S cs (a'#as'))) s
            = transfers (slice_kinds S (slice_edges S cs as')) 
                (transfer (slice_kind S a') s)"
      by(cases "kind a'")(auto simp:slice_kinds_def intra_kind_def)
    have "transfers (slice_kinds S (a'#as')) s
        = transfers (slice_kinds S as') (transfer (slice_kind S a') s)"
      by(simp add:slice_kinds_def)
    with eq IH[OF aset as'. intra_kind (kind a) 
      cset cs. sourcenode c  HRB_slice SCFG,
      of "transfer (slice_kind S a') s"]
    show ?thesis by simp
  next
    case False
    with ‹intra_kind (kind a')
    have eq:"transfers (slice_kinds S (slice_edges S cs (a'#as'))) s
            = transfers (slice_kinds S (slice_edges S cs as')) s"
      by(cases "kind a'")(auto simp:slice_kinds_def intra_kind_def)
    from False ‹intra_kind (kind a') cset cs. sourcenode c  HRB_slice SCFG
    have "sourcenode a'  HRB_slice SCFG"
      by(fastforce simp:slice_edge_def intra_kind_def)
    with ‹intra_kind (kind a') have "transfer (slice_kind S a') s = s"
      by(cases s)(auto,cases "kind a'",
        auto simp:slice_kind_def Let_def intra_kind_def)
    hence "transfers (slice_kinds S (a'#as')) s
         = transfers (slice_kinds S as') s"
      by(simp add:slice_kinds_def)
    with eq IH[OF aset as'. intra_kind (kind a) 
      cset cs. sourcenode c  HRB_slice SCFG,of s] show ?thesis by simp
  qed
qed



lemma exists_sliced_intra_path_preds:
  assumes "m -asι* m'" and "slice_edges S cs as = []" 
  and "m'  HRB_slice SCFG" and "c  set cs. sourcenode c  HRB_slice SCFG"
  obtains as' where "m -as'ι* m'" and "preds (slice_kinds S as') (cf#cfs)"
  and "slice_edges S cs as' = []"
proof(atomize_elim)
  from m -asι* m' have "m -as→* m'" and "a  set as. intra_kind(kind a)"
    by(simp_all add:intra_path_def)
  from ‹slice_edges S cs as = [] a  set as. intra_kind(kind a)
    c  set cs. sourcenode c  HRB_slice SCFG
  have "nx  set(sourcenodes as). nx  HRB_slice SCFG"
    by(rule slice_intra_edges_no_nodes_in_slice)
  with m -asι* m' m'  HRB_slice SCFG have "m'  obs_intra m HRB_slice SCFG"
    by(fastforce intro:obs_intra_elem)
  hence "obs_intra m HRB_slice SCFG = {m'}" by(rule obs_intra_singleton_element)
  from m -as→* m' have "valid_node m" and "valid_node m'"
    by(fastforce dest:path_valid_node)+
  from m -asι* m' obtain x where "distance m m' x" and "x  length as"
    by(erule every_path_distance)
  from ‹distance m m' x ‹obs_intra m HRB_slice SCFG = {m'}
  show "as'. m -as'ι* m'  preds (slice_kinds S as') (cf#cfs)  
              slice_edges S cs as' = []"
  proof(induct x arbitrary:m rule:nat.induct)
    case zero
    from ‹distance m m' 0 have "m = m'"
      by(fastforce elim:distance.cases simp:intra_path_def)
    with ‹valid_node m' show ?case
      by(rule_tac x="[]" in exI,
        auto intro:empty_path simp:slice_kinds_def intra_path_def)
  next
    case (Suc x)
    note IH = m. distance m m' x; obs_intra m HRB_slice SCFG = {m'}
       as'. m -as'ι* m'  preds (slice_kinds S as') (cf # cfs) 
               slice_edges S cs as' = []
    from ‹distance m m' (Suc x) obtain a 
      where "valid_edge a" and "m = sourcenode a" and "intra_kind(kind a)"
      and "distance (targetnode a) m' x"
      and target:"targetnode a = (SOME nx. a'. sourcenode a = sourcenode a'  
      distance (targetnode a') m' x 
      valid_edge a'  intra_kind(kind a')  targetnode a' = nx)"
      by(auto elim:distance_successor_distance)
    have "m  HRB_slice SCFG"
    proof
      assume "m  HRB_slice SCFG"
      from valid_edge a m = sourcenode a have "valid_node m" by simp
      with m  HRB_slice SCFG have "obs_intra m HRB_slice SCFG = {m}"
        by -(rule n_in_obs_intra)
      with ‹obs_intra m HRB_slice SCFG = {m'} have "m = m'" by simp
      with ‹valid_node m have "m -[]ι* m'" 
        by(fastforce intro:empty_path simp:intra_path_def)
      with ‹distance m m' (Suc x) show False
        by(fastforce elim:distance.cases)
    qed
    from ‹distance (targetnode a) m' x m'  HRB_slice SCFG
    obtain mx where "mx  obs_intra (targetnode a) HRB_slice SCFG"
      by(fastforce elim:distance.cases path_ex_obs_intra)
    from valid_edge a ‹intra_kind(kind a) m  HRB_slice SCFG m = sourcenode a
    have "obs_intra (targetnode a) HRB_slice SCFG  
      obs_intra (sourcenode a) HRB_slice SCFG"
      by -(rule edge_obs_intra_subset,auto)
    with mx  obs_intra (targetnode a) HRB_slice SCFG m = sourcenode a
      ‹obs_intra m HRB_slice SCFG = {m'}
    have "m'  obs_intra (targetnode a) HRB_slice SCFG" by auto
    hence "obs_intra (targetnode a) HRB_slice SCFG = {m'}" 
      by(rule obs_intra_singleton_element)
    from IH[OF ‹distance (targetnode a) m' x this]
    obtain as where "targetnode a -asι* m'" and "preds (slice_kinds S as) (cf#cfs)"
      and "slice_edges S cs as = []" by blast
    from targetnode a -asι* m' valid_edge a ‹intra_kind(kind a) 
      m = sourcenode a
    have "m -a#asι* m'" by(fastforce intro:Cons_path simp:intra_path_def)
    from c  set cs. sourcenode c  HRB_slice SCFG m  HRB_slice SCFG
      m = sourcenode a ‹intra_kind(kind a)
    have "¬ slice_edge S cs a" by(fastforce simp:slice_edge_def intra_kind_def)
    with ‹slice_edges S cs as = [] ‹intra_kind(kind a) 
    have "slice_edges S cs (a#as) = []" by(fastforce simp:intra_kind_def)
    from ‹intra_kind(kind a)
    show ?case
    proof(cases "kind a")
      case (UpdateEdge f)
      with m  HRB_slice SCFG m = sourcenode a have "slice_kind S a = id"
        by(fastforce intro:slice_kind_Upd)
      hence "transfer (slice_kind S a) (cf#cfs) = (cf#cfs)" 
        and "pred (slice_kind S a) (cf#cfs)" by simp_all
      with ‹preds (slice_kinds S as) (cf#cfs) 
      have "preds (slice_kinds S (a#as)) (cf#cfs)"
        by(simp add:slice_kinds_def)
      with m -a#asι* m' ‹slice_edges S cs (a#as) = [] show ?thesis
        by blast
    next
      case (PredicateEdge Q)
      with m  HRB_slice SCFG m = sourcenode a ‹distance m m' (Suc x)  
        ‹obs_intra m HRB_slice SCFG = {m'} ‹distance (targetnode a) m' x
        target
      have "slice_kind S a = (λs. True)"
        by(fastforce intro:slice_kind_Pred_obs_nearer_SOME)
      hence "transfer (slice_kind S a) (cf#cfs) = (cf#cfs)" 
        and "pred (slice_kind S a) (cf#cfs)" by simp_all
      with ‹preds (slice_kinds S as) (cf#cfs) 
      have "preds (slice_kinds S (a#as)) (cf#cfs)"
        by(simp add:slice_kinds_def)
      with m -a#asι* m' ‹slice_edges S cs (a#as) = [] show ?thesis by blast
    qed (auto simp:intra_kind_def)
  qed
qed


lemma slp_to_intra_path_with_slice_edges:
  assumes "n -assl* n'" and "slice_edges S cs as = []"
  obtains as' where "n -as'ι* n'" and "slice_edges S cs as' = []"
proof(atomize_elim)
  from n -assl* n' have "n -as→* n'" and "same_level_path as"
    by(simp_all add:slp_def)
  from ‹same_level_path as have "same_level_path_aux [] as" and "upd_cs [] as = []"
    by(simp_all add:same_level_path_def)
  from n -as→* n' ‹same_level_path_aux [] as ‹upd_cs [] as = [] 
    ‹slice_edges S cs as = []
  show "as'. n -as'ι* n'  slice_edges S cs as' = []"
  proof(induct as arbitrary:n cs rule:length_induct)
    fix as n cs
    assume IH:"as''. length as'' < length as 
      (n''. n'' -as''→* n'  same_level_path_aux [] as'' 
           upd_cs [] as'' = []  (cs'. slice_edges S cs' as'' = [] 
           (as'. n'' -as'ι* n'  slice_edges S cs' as' = [])))"
      and "n -as→* n'" and "same_level_path_aux [] as" and "upd_cs [] as = []"
      and "slice_edges S cs as = []"
    show "as'. n -as'ι* n'  slice_edges S cs as' = []"
    proof(cases as)
      case Nil
      with n -as→* n' show ?thesis by(fastforce simp:intra_path_def)
    next
      case (Cons a' as')
      with n -as→* n' Cons have "n = sourcenode a'" and "valid_edge a'" 
        and "targetnode a' -as'→* n'"
        by(auto intro:path_split_Cons)
      show ?thesis
      proof(cases "kind a'" rule:edge_kind_cases)
        case Intra
        with Cons ‹same_level_path_aux [] as have "same_level_path_aux [] as'"
          by(fastforce simp:intra_kind_def)
        moreover
        from Intra Cons ‹upd_cs [] as = [] have "upd_cs [] as' = []"
          by(fastforce simp:intra_kind_def)
        moreover
        from ‹slice_edges S cs as = [] Cons Intra
        have "slice_edges S cs as' = []" and "¬ slice_edge S cs a'"
          by(cases "slice_edge S cs a'",auto simp:intra_kind_def)+
        ultimately obtain as'' where "targetnode a' -as''ι* n'"
          and "slice_edges S cs as'' = []"
          using IH Cons targetnode a' -as'→* n'
          by(erule_tac x="as'" in allE) auto
        from n = sourcenode a' valid_edge a' Intra targetnode a' -as''ι* n'
        have "n -a'#as''ι* n'" by(fastforce intro:Cons_path simp:intra_path_def)
        moreover
        from ‹slice_edges S cs as'' = [] ¬ slice_edge S cs a' Intra
        have "slice_edges S cs (a'#as'') = []" by(auto simp:intra_kind_def)
        ultimately show ?thesis by blast
      next
        case (Call Q r p f)
        with Cons ‹same_level_path_aux [] as
        have "same_level_path_aux [a'] as'" by simp
        from Call Cons ‹upd_cs [] as = [] have "upd_cs [a'] as' = []"
          by simp
        hence "as'  []" by fastforce
        with ‹upd_cs [a'] as' = [] obtain xs ys where "as' = xs@ys" and "xs  []"
        and "upd_cs [a'] xs = []" and "upd_cs [] ys = []"
        and "xs' ys'. xs = xs'@ys'  ys'  []  upd_cs [a'] xs'  []"
          by -(erule upd_cs_empty_split,auto)
        from ‹same_level_path_aux [a'] as' as' = xs@ys ‹upd_cs [a'] xs = []
        have "same_level_path_aux [a'] xs"  and "same_level_path_aux [] ys"
          by(rule slpa_split)+
        with ‹upd_cs [a'] xs = [] have "upd_cs ([a']@cs) xs = []@cs"
          by(fastforce intro:same_level_path_upd_cs_callstack_Append)
        from ‹slice_edges S cs as = [] Cons Call
        have "slice_edges S (a'#cs) as' = []" and "¬ slice_edge S cs a'"
          by(cases "slice_edge S cs a'",auto)+
        from ‹slice_edges S (a'#cs) as' = [] as' = xs@ys 
          ‹upd_cs ([a']@cs) xs = []@cs
        have "slice_edges S cs ys = []" 
          by(fastforce dest:slice_edges_Nil_split)
        from ‹same_level_path_aux [a'] xs ‹upd_cs [a'] xs = []
          xs' ys'. xs = xs'@ys'  ys'  []  upd_cs [a'] xs'  []
        have "last xs  get_return_edges (last [a'])"
          by(fastforce intro!:slpa_get_return_edges)
        with valid_edge a' Call
        obtain a where "valid_edge a" and "sourcenode a = sourcenode a'"
          and "targetnode a = targetnode (last xs)" and "kind a = (λcf. False)"
          by -(drule call_return_node_edge,auto)
        from targetnode a = targetnode (last xs) xs  []
        have "targetnode a = targetnode (last (a'#xs))" by simp
        from as' = xs@ys xs  [] Cons have "length ys < length as" by simp
        from targetnode a' -as'→* n' as' = xs@ys xs  []
        have "targetnode (last (a'#xs)) -ys→* n'"
          by(cases xs rule:rev_cases,auto dest:path_split)
        with IH ‹length ys < length as ‹same_level_path_aux [] ys
          ‹upd_cs [] ys = [] ‹slice_edges S cs ys = []
        obtain as'' where "targetnode (last (a'#xs)) -as''ι* n'"
          and "slice_edges S cs as'' = []"
          apply(erule_tac x="ys" in allE) apply clarsimp
          apply(erule_tac x="targetnode (last (a'#xs))" in allE) 
          apply clarsimp apply(erule_tac x="cs" in allE)
          by clarsimp
        from sourcenode a = sourcenode a' n = sourcenode a'
          targetnode a = targetnode (last (a'#xs)) valid_edge a
          kind a = (λcf. False) targetnode (last (a'#xs)) -as''ι* n'
        have "n -a#as''ι* n'"
          by(fastforce intro:Cons_path simp:intra_path_def intra_kind_def)
        moreover
        from kind a = (λcf. False) ‹slice_edges S cs as'' = []
          ¬ slice_edge S cs a' sourcenode a = sourcenode a'
        have "slice_edges S cs (a#as'') = []" 
          by(cases "kind a'")(auto simp:slice_edge_def)
        ultimately show ?thesis by blast
      next
        case (Return Q p f)
        with Cons ‹same_level_path_aux [] as have False by simp
        thus ?thesis by simp
      qed
    qed
  qed
qed


subsection S,f ⊢ (ms,s) =as⇒* (ms',s')› : the reflexive transitive 
  closure of S,f ⊢ (ms,s) =as⇒ (ms',s')›


inductive trans_observable_moves :: 
  "'node SDG_node set  ('edge  ('var,'val,'ret,'pname) edge_kind)  'node list  
   (('var  'val) × 'ret) list  'edge list  'node list  
  (('var  'val) × 'ret) list  bool"
("_,_  '(_,_') =_⇒* '(_,_')" [51,50,0,0,50,0,0] 51) 

where tom_Nil:
  "length ms = length s  S,f  (ms,s) =[]⇒* (ms,s)"

| tom_Cons:
  "S,f  (ms,s) =as (ms',s'); S,f  (ms',s') =as'⇒* (ms'',s'')
   S,f  (ms,s) =(last as)#as'⇒* (ms'',s'')"


lemma tom_split_snoc:
  assumes "S,f  (ms,s) =as⇒* (ms',s')" and "as  []"
  obtains asx asx' ms'' s'' where "as = asx@[last asx']" 
  and "S,f  (ms,s) =asx⇒* (ms'',s'')" and "S,f  (ms'',s'') =asx' (ms',s')"
proof(atomize_elim)
  from assms show "asx asx' ms'' s''. as = asx @ [last asx'] 
    S,f  (ms,s) =asx⇒* (ms'',s'')  S,f  (ms'',s'') =asx' (ms',s')"
  proof(induct rule:trans_observable_moves.induct)
    case (tom_Cons S f ms s as ms' s' as' ms'' s'')
    note IH = as'  []  asx asx' msx sx. as' = asx @ [last asx'] 
      S,f  (ms',s') =asx⇒* (msx,sx)  S,f  (msx,sx) =asx' (ms'',s'')
    show ?case
    proof(cases "as' = []")
      case True
      with S,f  (ms',s') =as'⇒* (ms'',s'') have [simp]:"ms'' = ms'" "s'' = s'"
        by(auto elim:trans_observable_moves.cases)
      from S,f  (ms,s) =as (ms',s') have "length ms = length s"
        by(rule observable_moves_equal_length)
      hence "S,f  (ms,s) =[]⇒* (ms,s)" by(rule tom_Nil)
      with S,f  (ms,s) =as (ms',s') True show ?thesis by fastforce
    next
      case False
      from IH[OF this] obtain xs xs' msx sx where "as' = xs @ [last xs']"
        and "S,f  (ms',s') =xs⇒* (msx,sx)" 
        and "S,f  (msx,sx) =xs' (ms'',s'')" by blast
      from S,f  (ms,s) =as (ms',s') S,f  (ms',s') =xs⇒* (msx,sx)
      have "S,f  (ms,s) =(last as)#xs⇒* (msx,sx)"
        by(rule trans_observable_moves.tom_Cons)
      with S,f  (msx,sx) =xs' (ms'',s'') as' = xs @ [last xs']
      show ?thesis by fastforce
    qed
  qed simp
qed


lemma tom_preserves_stacks:
  assumes "S,f  (m#ms,s) =as⇒* (m'#ms',s')" and "valid_node m" 
  and "valid_call_list cs m" and "i < length rs. rs!i  get_return_edges (cs!i)" 
  and "valid_return_list rs m" and "length rs = length cs" and "ms = targetnodes rs"
  obtains cs' rs' where "valid_node m'" and "valid_call_list cs' m'"
  and "i < length rs'. rs'!i  get_return_edges (cs'!i)"
  and "valid_return_list rs' m'" and "length rs' = length cs'" 
  and "ms' = targetnodes rs'"
proof(atomize_elim)
  from assms show "cs' rs'. valid_node m'  valid_call_list cs' m' 
    (i<length rs'. rs' ! i  get_return_edges (cs' ! i))  valid_return_list rs' m' 
    length rs' = length cs'  ms' = targetnodes rs'"
  proof(induct S f "m#ms" s as "m'#ms'" s' arbitrary:m ms cs rs
      rule:trans_observable_moves.induct)
    case (tom_Nil sx nc f)
    thus ?case
      apply(rule_tac x="cs" in exI)
      apply(rule_tac x="rs" in exI)
      by clarsimp
  next
    case (tom_Cons S f sx as msx' sx' as' sx'')
    note IH = m ms cs rs. msx' = m # ms; valid_node m; valid_call_list cs m;
      i<length rs. rs ! i  get_return_edges (cs ! i); valid_return_list rs m;
      length rs = length cs; ms = targetnodes rs
       cs' rs'. valid_node m'  valid_call_list cs' m' 
      (i<length rs'. rs' ! i  get_return_edges (cs' ! i)) 
      valid_return_list rs' m'  length rs' = length cs' 
      ms' = targetnodes rs'
    from S,f  (m # ms,sx) =as (msx',sx')
    obtain m'' ms'' where "msx' = m''#ms''"
      apply(cases msx') apply(auto elim!:observable_moves.cases observable_move.cases)
      by(case_tac "msaa") auto
    with S,f  (m # ms,sx) =as (msx',sx') ‹valid_node m
      ‹valid_call_list cs m i<length rs. rs ! i  get_return_edges (cs ! i)
      ‹valid_return_list rs m ‹length rs = length cs ms = targetnodes rs
    obtain cs'' rs'' where "valid_node m''" and "valid_call_list cs'' m''"
      and "i < length rs''. rs''!i  get_return_edges (cs''!i)"
      and "valid_return_list rs'' m''" and "length rs'' = length cs''" 
      and "ms'' = targetnodes rs''"
      by(auto elim!:observable_moves_preserves_stack)
    from IH[OF msx' = m''#ms'' this(1-6)]
    show ?case by fastforce
  qed
qed




lemma vpa_trans_observable_moves:
  assumes "valid_path_aux cs as" and "m -as→* m'" and "preds (kinds as) s" 
  and "transfers (kinds as) s = s'" and "valid_call_list cs m"
  and "i < length rs. rs!i  get_return_edges (cs!i)"
  and "valid_return_list rs m" 
  and "length rs = length cs" and "length s = Suc (length cs)" 
  obtains ms ms'' s'' ms' as' as''
  where "S,kind  (m#ms,s) =slice_edges S cs as⇒* (ms'',s'')"
  and "S,kind  (ms'',s'') =as'τ (m'#ms',s')" 
  and "ms = targetnodes rs" and "length ms = length cs"
  and "i<length cs. call_of_return_node (ms!i) (sourcenode (cs!i))"
  and "slice_edges S cs as = slice_edges S cs as''" 
  and "m -as''@as'→* m'" and "valid_path_aux cs (as''@as')"
proof(atomize_elim)
  from assms show "ms ms'' s'' as' ms' as''.
    S,kind  (m # ms,s) =slice_edges S cs as⇒* (ms'',s'') 
    S,kind  (ms'',s'') =as'τ (m' # ms',s')  
    ms = targetnodes rs  length ms = length cs 
    (i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))) 
    slice_edges S cs as = slice_edges S cs as'' 
    m -as'' @ as'→* m'  valid_path_aux cs (as'' @ as')"
  proof(induct arbitrary:m s rs rule:vpa_induct)
    case (vpa_empty cs)
    from m -[]→* m' have [simp]:"m' = m" by fastforce
    from ‹transfers (kinds []) s = s' ‹length s = Suc (length cs) 
    have [simp]:"s' = s" by(cases cs)(auto simp:kinds_def)
    from ‹valid_call_list cs m ‹valid_return_list rs m
      i<length rs. rs ! i  get_return_edges (cs ! i) ‹length rs = length cs
    have "i<length cs. call_of_return_node (targetnodes rs!i) (sourcenode (cs!i))"
      by(rule get_return_edges_call_of_return_nodes)
    with ‹length s = Suc (length cs) m -[]→* m' ‹length rs = length cs show ?case
      apply(rule_tac x="targetnodes rs" in exI)
      apply(rule_tac x="m#targetnodes rs" in exI)
      apply(rule_tac x="s" in exI)
      apply(rule_tac x="[]" in exI)
      apply(rule_tac x="targetnodes rs" in exI)
      apply(rule_tac x="[]" in exI)
      by(fastforce intro:tom_Nil silent_moves_Nil simp:targetnodes_def)
  next
    case (vpa_intra cs a as)
    note IH = m s rs. m -as→* m'; preds (kinds as) s; transfers (kinds as) s = s';
      valid_call_list cs m; i<length rs. rs ! i  get_return_edges (cs ! i);
      valid_return_list rs m; length rs = length cs; length s = Suc (length cs)
       ms ms'' s'' as' ms' as''.
      S,kind  (m # ms,s) =slice_edges S cs as⇒* (ms'',s'') 
      S,kind  (ms'',s'') =as'τ (m' # ms',s')  ms = targetnodes rs 
      length ms = length cs 
      (i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))) 
      slice_edges S cs as = slice_edges S cs as'' 
      m -as'' @ as'→* m'  valid_path_aux cs (as'' @ as')
    from m -a # as→* m' have "m = sourcenode a" and "valid_edge a"
      and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
    from ‹preds (kinds (a # as)) s have "pred (kind a) s"
      and "preds (kinds as) (transfer (kind a) s)" by(auto simp:kinds_def)
    from ‹transfers (kinds (a # as)) s = s'
    have "transfers (kinds as) (transfer (kind a) s) = s'" by(fastforce simp:kinds_def)
    from valid_edge a ‹intra_kind (kind a)
    have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
    from ‹valid_call_list cs m m = sourcenode a
      get_proc (sourcenode a) = get_proc (targetnode a)
    have "valid_call_list cs (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(erule_tac x="cs'" in allE)
      apply(erule_tac x="c" in allE)
      by(auto split:list.split)
    from ‹intra_kind (kind a) ‹length s = Suc (length cs)
    have "length (transfer (kind a) s) = Suc (length cs)"
      by(cases s)(auto simp:intra_kind_def)
   from ‹valid_return_list rs m m = sourcenode a 
     get_proc (sourcenode a) = get_proc (targetnode a)
    have "valid_return_list rs (targetnode a)"
      apply(clarsimp simp:valid_return_list_def)
      apply(erule_tac x="cs'" in allE) apply clarsimp
      by(case_tac cs') auto
    from IH[OF targetnode a -as→* m' ‹preds (kinds as) (transfer (kind a) s)
      ‹transfers (kinds as) (transfer (kind a) s) = s' 
      ‹valid_call_list cs (targetnode a) 
      i<length rs. rs ! i  get_return_edges (cs ! i) this ‹length rs = length cs
      ‹length (transfer (kind a) s) = Suc (length cs)]
    obtain ms ms'' s'' as' ms' as'' where "length ms = length cs"
      and "S,kind  (targetnode a # ms,transfer (kind a) s) =slice_edges S cs as⇒*
                       (ms'',s'')" 
      and paths:"S,kind  (ms'',s'') =as'τ (m' # ms',s')"
      "ms = targetnodes rs"
      "i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))"
      "slice_edges S cs as = slice_edges S cs as''"
      "targetnode a -as'' @ as'→* m'" "valid_path_aux cs (as'' @ as')"
      by blast
    from i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))
      ‹length ms = length cs
    have "mx  set ms. return_node mx"
      by(auto simp:call_of_return_node_def in_set_conv_nth)
    show ?case
    proof(cases "(m  set ms. m'. call_of_return_node m m'  
        m'  HRB_slice SCFG)  m  HRB_slice SCFG")
      case True
      with m = sourcenode a ‹length ms = length cs ‹intra_kind (kind a)
        i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))
      have "slice_edge S cs a"
        by(fastforce simp:slice_edge_def in_set_conv_nth intra_kind_def)
      with ‹intra_kind (kind a)
      have "slice_edges S cs (a#as) = a#slice_edges S cs as"
        by(fastforce simp:intra_kind_def)
      from True ‹pred (kind a) s valid_edge a ‹intra_kind (kind a)
        mx  set ms. return_node mx ‹length ms = length cs m = sourcenode a
        ‹length s = Suc (length cs) ‹length (transfer (kind a) s) = Suc (length cs)
      have "S,kind  (sourcenode a#ms,s) -a (targetnode a#ms,transfer (kind a) s)"
        by(fastforce intro!:observable_move_intra)
      with ‹length ms = length cs ‹length s = Suc (length cs)
      have "S,kind  (sourcenode a#ms,s) =[]@[a] 
                      (targetnode a#ms,transfer (kind a) s)"
        by(fastforce intro:observable_moves_snoc silent_moves_Nil)
      with S,kind  (targetnode a # ms,transfer (kind a) s) =slice_edges S cs as⇒*
        (ms'',s'')
      have "S,kind  (sourcenode a#ms,s) =last [a]#slice_edges S cs as⇒* (ms'',s'')"
        by(fastforce intro:tom_Cons)
      with ‹slice_edges S cs (a#as) = a#slice_edges S cs as
      have "S,kind  (sourcenode a#ms,s) =slice_edges S cs (a#as)⇒* (ms'',s'')"
        by simp
      moreover
      from ‹slice_edges S cs as = slice_edges S cs as'' ‹slice_edge S cs a
        ‹intra_kind (kind a)
      have "slice_edges S cs (a#as) = slice_edges S cs (a#as'')"
        by(fastforce simp:intra_kind_def)
      ultimately show ?thesis 
        using paths m = sourcenode a valid_edge a ‹intra_kind (kind a)
        ‹length ms = length cs ‹slice_edges S cs (a#as) = a#slice_edges S cs as
        apply(rule_tac x="ms" in exI)
        apply(rule_tac x="ms''" in exI)
        apply(rule_tac x="s''" in exI)
        apply(rule_tac x="as'" in exI)
        apply(rule_tac x="ms'" in exI)
        apply(rule_tac x="a#as''" in exI)
        by(auto intro:Cons_path simp:intra_kind_def)
    next
      case False
      with mx  set ms. return_node mx
      have disj:"(m  set ms. m'. call_of_return_node m m'  
        m'  HRB_slice SCFG)  m  HRB_slice SCFG"
        by(fastforce dest:return_node_call_of_return_node)
      with m = sourcenode a ‹length ms = length cs ‹intra_kind (kind a)
        i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))
      have "¬ slice_edge S cs a" 
        by(fastforce simp:slice_edge_def in_set_conv_nth intra_kind_def)
      with ‹intra_kind (kind a)
      have "slice_edges S cs (a#as) = slice_edges S cs as"
        by(fastforce simp:intra_kind_def)
      from disj ‹pred (kind a) s valid_edge a ‹intra_kind (kind a)
        mx  set ms. return_node mx ‹length ms = length cs m = sourcenode a
        ‹length s = Suc (length cs) ‹length (transfer (kind a) s) = Suc (length cs)
      have "S,kind  (sourcenode a#ms,s) -aτ (targetnode a#ms,transfer (kind a) s)"
        by(fastforce intro!:silent_move_intra)
      from S,kind  (targetnode a # ms,transfer (kind a) s) =slice_edges S cs as⇒*
                      (ms'',s'')
      show ?thesis
      proof(rule trans_observable_moves.cases)
        fix msx sx nc' f
        assume "targetnode a # ms = msx"
          and "transfer (kind a) s = sx" and "slice_edges S cs as = []"
          and [simp]:"ms'' = msx" "s'' = sx" and "length msx = length sx"
        from ‹slice_edges S cs (a#as) = slice_edges S cs as 
          ‹slice_edges S cs as = []
        have "slice_edges S cs (a#as) = []" by simp 
        with ‹length ms = length cs ‹length s = Suc (length cs)
        have "S,kind  (sourcenode a#ms,s) =slice_edges S cs (a#as)⇒*
                        (sourcenode a#ms,s)"
          by(fastforce intro:tom_Nil)
        moreover
        from S,kind  (ms'',s'') =as'τ (m'#ms',s') targetnode a # ms = msx
          ‹transfer (kind a) s = sx ms'' = msx s'' = sx
          S,kind  (sourcenode a#ms,s) -aτ (targetnode a#ms,transfer (kind a) s)
        have "S,kind  (sourcenode a#ms,s) =a#as'τ (m'#ms',s')"
          by(fastforce intro:silent_moves_Cons)
        from this valid_edge a i<length rs. rs ! i  get_return_edges (cs ! i)
          ms = targetnodes rs ‹valid_return_list rs m ‹length rs = length cs
          ‹length s = Suc (length cs) m = sourcenode a
        have "sourcenode a -a#as'→* m'" and "valid_path_aux cs (a#as')"
          by -(rule silent_moves_vpa_path,(fastforce simp:targetnodes_def)+)+
        ultimately show ?thesis using m = sourcenode a ‹length ms = length cs
          i<length cs. call_of_return_node (ms ! i) (sourcenode (cs ! i))
          ‹slice_edges S cs (a#as) = [] ‹intra_kind (kind a)
          S,kind  (sourcenode a#ms,s) =a#as'τ (m'#ms',s')
          ms = targetnodes rs
          apply(rule_tac x="ms" in exI)
          apply(rule_tac x="sourcenode a#ms" in exI)
          apply(rule_tac x="s" in exI)
          apply(rule_tac x="a#as'" in exI)
          apply(rule_tac x="ms'" in exI)
          apply(rule_tac x="[]" in exI)
          by(auto simp:intra_kind_def)
      next
        fix S' f msx sx asx msx' sx' asx' msx'' sx''
        assume [simp]:"S = S'" and "kind = f" and "targetnode a # ms = msx"
          and "transfer (kind a) s = sx" and "slice_edges S cs as = last asx # asx'"
          and "ms'' = msx''" and "s'' = sx''" 
          and "S',f  (msx,sx) =asx (msx',sx')"
          and "S',f  (msx',sx') =asx'⇒* (msx'',sx'')"
        from kind = f have [simp]:"f = kind" by simp
        from S,kind  (sourcenode a#ms,s) -aτ 
          (targetnode a#ms,transfer (kind a) s) S',f  (msx,sx) =asx (msx',sx')
          ‹transfer (kind a) s = sx targetnode a # ms = msx
        have "S,kind  (sourcenode a#ms,s) =a#asx (msx',sx')"
          by(fastforce intro:silent_move_observable_moves)
        with S',f  (msx',sx') =asx'⇒* (msx'',sx'') ms'' = msx'' s'' = sx''
        have "S,kind  (sourcenode a#ms,s) =last (a#asx)#asx'⇒* (ms'',s'')"
          by(fastforce intro:trans_observable_moves.tom_Cons)
        moreover
        from S',f  (msx,sx) =asx (msx',sx') have "asx  []"
          by(fastforce elim:observable_moves.cases)
        with ‹slice_edges S cs (a#as) = slice_edges S cs as
          ‹slice_edges S cs as = last asx # asx'
        have "slice_edges S cs (a#as) = last (a#asx)#asx'" by simp
        moreover
        from ¬ slice_edge S cs a ‹slice_edges S cs as = slice_edges S cs as''
          ‹intra_kind (kind a)
        have "slice_edges S cs (a # as) = slice_edges S cs (a # as'')"
          by(fastforce simp:intra_kind_def)
        ultimately show ?thesis using paths m = sourcenode a ‹intra_kind (kind a)
          ‹length ms = length cs ms = targetnodes rs valid_edge a
          apply(rule_tac x="ms" in exI)
          apply(rule_tac x="ms''" in exI)
          apply(rule_tac x="s''" in exI)
          apply(rule_tac x="as'" in exI)
          apply(rule_tac x="ms'" in exI)
          apply(rule_tac x="a#as''" in exI)
          by(auto intro:Cons_path simp:intra_kind_def)
      qed
    qed
  next
    case (vpa_Call cs a as Q r p fs)
    note IH = m s rs. m -as→* m'; preds (kinds as) s; transfers (kinds as) s = s';
      valid_call_list (a # cs) m;
      i<length rs. rs ! i  get_return_edges ((a # cs) ! i);
      valid_return_list rs m; length rs = length (a # cs);
      length s = Suc (length (a # cs))
       ms ms'' s'' as' ms' as''.
      S,kind  (m # ms,s) =slice_edges S (a # cs) as⇒* (ms'',s'') 
      S,kind  (ms'',s'') =as'τ (m' # ms',s')  ms = targetnodes rs 
      length ms = length (a # cs) 
      (i<length (a # cs). call_of_return_node (ms ! i) (sourcenode ((a # cs) ! i))) 
      slice_edges S (a # cs) as = slice_edges S (a # cs) as'' 
      m -as'' @ as'→* m'  valid_path_aux (a # cs) (as'' @ as')
    from m -a # as→* m' have "m = sourcenode a" and "valid_edge a"
      and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
    from ‹preds (kinds (a # as)) s have "pred (kind a) s"
      and "preds (kinds as) (transfer (kind a) s)" by(auto simp:kinds_def)
    from ‹transfers (kinds (a # as)) s = s'
    have "transfers (kinds as) (transfer (kind a) s) = s'" by(fastforce simp:kinds_def)
    from valid_edge a kind a = Q:rpfs have "get_proc (targetnode a) = p"
      by(rule get_proc_call)
    with ‹valid_call_list cs m valid_edge a kind a = Q:rpfs m = sourcenode a
    have "valid_call_list (a # cs) (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(case_tac cs') apply auto
      apply(erule_tac x="list" in allE)
      by(case_tac list)(auto simp:sourcenodes_def)
    from valid_edge a kind a = Q:rpfs obtain a' where "a'  get_return_edges a"
      by(fastforce dest:get_return_edge_call)
    with valid_edge a kind a = Q:rpfs obtain Q' f' where "kind a' = Q'pf'"
      by(fastforce dest!:call_return_edges)
    from valid_edge a a'  get_return_edges a have "valid_edge a'" 
      by(rule get_return_edges_valid)
    from valid_edge a' kind a' = Q'pf' have "get_proc (sourcenode a') = p"
      by(rule get_proc_return)
    from i<length rs. rs ! i  get_return_edges (cs ! i) a'  get_return_edges a
    have "i<length (a'#rs). (a'#rs) ! i  get_return_edges ((a#cs) ! i)"
      by auto(case_tac i,auto)
    from valid_edge a a'  get_return_edges a
    have "get_proc (sourcenode a) = get_proc (targetnode a')" 
      by(rule get_proc_get_return_edge)
    with ‹valid_return_list rs m valid_edge a' kind a' = Q'pf'
      get_proc (sourcenode a') = p get_proc (targetnode a) = p m = sourcenode a
    have "valid_return_list (a'#rs) (targetnode a)"
      apply(clarsimp simp:valid_return_list_def)
      apply(case_tac cs') apply auto
      apply(erule_tac x="list" in allE)
      by(case_tac list)(auto simp:targetnodes_def)
    from ‹length rs = length cs have "length (a'#rs) = length (a#cs)" by simp
    from ‹length s = Suc (length cs) kind a = Q:rpfs
    have "length (transfer (kind a) s) = Suc (length (a#cs))"
      by(cases s) auto
    from IH[OF targetnode a -as→* m' ‹preds (kinds as) (transfer (kind a) s)
      ‹transfers (kinds as) (transfer (kind a) s) = s' 
      ‹valid_call_list (a # cs) (targetnode a) 
      i<length (a'#rs). (a'#rs) ! i  get_return_edges ((a#cs) ! i)
      ‹valid_return_list (a'#rs) (targetnode a) ‹length (a'#rs) = length (a#cs)
      ‹length (transfer (kind a) s) = Suc (length (a#cs))]
    obtain ms ms'' s'' as' ms' as'' where "length ms = length (a#cs)"
      and "S,kind  (targetnode a # ms,transfer (kind a) s) 
                     =slice_edges S (a#cs) as⇒* (ms'',s'')" 
      and paths:"S,kind  (ms'',s'') =as'τ (m' # ms',s')"
      "ms = targetnodes (a'#rs)"
      "i<length (a#cs). call_of_return_node (ms ! i) (sourcenode ((a#cs) ! i))"
      "slice_edges S (a#cs) as = slice_edges S (a#cs) as''"
      "targetnode a -as'' @ as'→* m'" "valid_path_aux (a#cs) (as'' @ as')"
      by blast
    from ms = targetnodes (a'#rs) obtain x xs where [simp]:"ms = x#xs"
      and "x = targetnode a'" and "xs = targetnodes rs"
      by(cases ms)(auto simp:targetnodes_def)
    from i<length (a#cs). call_of_return_node (ms ! i) (sourcenode ((a#cs) ! i))
      ‹length ms = length (a#cs)
    have "mx  set xs. return_node mx"
      apply(auto simp:in_set_conv_nth) apply(case_tac i)
      apply(erule_tac x="Suc 0" in allE)
      by(auto simp:call_of_return_node_def)
    show ?case
    proof(cases "(m  set xs. m'. call_of_return_node m m'  
        m'  HRB_slice SCFG)  sourcenode a  HRB_slice SCFG")
      case True
      with i<length (a#cs). call_of_return_node (ms ! i) (sourcenode ((a#cs) ! i))
        ‹length ms = length (a#cs) kind a = Q:rpfs
      have "slice_edge S cs a"
        apply(auto simp:slice_edge_def in_set_conv_nth)
        by(erule_tac x="Suc i" in allE) auto
      with kind a = Q:rpfs
      have "slice_edges S cs (a#as) = a#slice_edges S (a#cs) as" by simp
      from True ‹pred (kind a) s valid_edge a kind a = Q:rpfs
        valid_edge a' a'  get_return_edges a
        mx  set xs. return_node mx ‹length ms = length (a#cs) m = sourcenode a
        ‹length s = Suc (length cs) 
        ‹length (transfer (kind a) s) = Suc (length (a#cs))
      have "S,kind  (sourcenode a#xs,s) -a 
        (targetnode a#targetnode a'#xs,transfer (kind a) s)"
        by -(rule_tac a'="a'" in observable_move_call,fastforce+)
      with ‹length ms = length (a#cs) ‹length s = Suc (length cs)
      have "S,kind  (sourcenode a#xs,s) =[]@[a] 
        (targetnode a#targetnode a'#xs,transfer (kind a) s)"
        by(fastforce intro:observable_moves_snoc silent_moves_Nil)
      with S,kind  (targetnode a # ms,transfer (kind a) s) 
        =slice_edges S (a#cs) as⇒* (ms'',s'') x = targetnode a'
      have "S,kind  (sourcenode a#xs,s) =last [a]#slice_edges S (a#cs) as⇒* 
        (ms'',s'')"
        by -(rule tom_Cons,auto)
      with ‹slice_edges S cs (a#as) = a#slice_edges S (a#cs) as
      have "S,kind  (sourcenode a#xs,s) =slice_edges S cs (a#as)⇒* (ms'',s'')"
        by simp
      moreover
      from ‹slice_edges S (a#cs) as = slice_edges S (a#cs) as''
        ‹slice_edge S cs a kind a = Q:rpfs
      have "slice_edges S cs (a#as) = slice_edges S cs (a#as'')" by simp
      ultimately show ?thesis
        using paths m = sourcenode a valid_edge a kind a = Q:rpfs
          ‹length ms = length (a#cs) xs = targetnodes rs
          ‹slice_edges S cs (a#as) = a#slice_edges S (a#cs) as
        apply(rule_tac x="xs" in exI)
        apply(rule_tac x="ms''" in exI)
        apply(rule_tac x="s''" in exI)
        apply(rule_tac x="as'" in exI)
        apply(rule_tac x="ms'" in exI)
        apply(rule_tac x="a#as''" in exI)
        by(auto intro:Cons_path simp:targetnodes_def)
    next
      case False
      with mx  set xs. return_node mx
      have disj:"(m  set xs. m'. call_of_return_node m m'  
        m'  HRB_slice SCFG)  sourcenode a  HRB_slice SCFG"
        by(fastforce dest:return_node_call_of_return_node)
      with i<length (a#cs). call_of_return_node (ms ! i) (sourcenode ((a#cs) ! i))
        ‹length ms = length (a#cs) kind a = Q:rpfs
      have "¬ slice_edge S cs a"
        apply(auto simp:slice_edge_def in_set_conv_nth)
        by(erule_tac x="Suc i" in allE) auto
      with kind a = Q:rpfs
      have "slice_edges S cs (a#as) = slice_edges S (a#cs) as" by simp
      from disj ‹pred (kind a) s valid_edge a kind a = Q:rpfs
        valid_edge a' a'  get_return_edges a
        mx  set xs. return_node mx ‹length ms = length (a#cs) m = sourcenode a
        ‹length s = Suc (length cs) 
        ‹length (transfer (kind a) s) = Suc (length (a#cs))
      have "S,kind  (sourcenode a#xs,s) -aτ
        (targetnode a#targetnode a'#xs,transfer (kind a) s)"
        by -(rule_tac a'="a'" in silent_move_call,fastforce+)
      from S,kind  (targetnode a # ms,transfer (kind a) s) 
        =slice_edges S (a#cs) as⇒* (ms'',s'')
      show ?thesis
      proof(rule trans_observable_moves.cases)
        fix msx sx S' f
        assume "targetnode a # ms = msx"
          and "transfer (kind a) s = sx" and "slice_edges S (a#cs) as = []"
          and [simp]:"ms'' = msx" "s'' = sx" and "length msx = length sx"
        from ‹slice_edges S cs (a#as) = slice_edges S (a#cs) as 
          ‹slice_edges S (a#cs) as = []
        have "slice_edges S cs (a#as) = []" by simp
        with ‹length ms = length (a#cs) ‹length s = Suc (length cs)
        have "S,kind  (sourcenode a#xs,s) =slice_edges S cs (a#as)⇒*
                        (sourcenode a#xs,s)"
          by(fastforce intro:tom_Nil)
        moreover
        from S,kind  (ms'',s'') =as'τ (m'#ms',s') targetnode a # ms = msx
          ‹transfer (kind a) s = sx ms'' = msx s'' = sx x = targetnode a'
          S,kind  (sourcenode a#xs,s) -aτ 
          (targetnode a#targetnode a'#xs,transfer (kind a) s)
        have "S,kind  (sourcenode a#xs,s) =a#as'τ (m'#ms',s')"
          by(auto intro:silent_moves_Cons)
        from this valid_edge a 
          i<length rs. rs ! i  get_return_edges (cs ! i)
          xs = targetnodes rs ‹valid_return_list rs m ‹length rs = length cs
          ‹length s = Suc (length cs) m = sourcenode a
        have "sourcenode a -a#as'→* m'" and "valid_path_aux cs (a#as')"
          by -(rule silent_moves_vpa_path,(fastforce simp:targetnodes_def)+)+
        ultimately show ?thesis using m = sourcenode a ‹length ms = length (a#cs)
          i<length (a#cs). call_of_return_node (ms ! i) (sourcenode ((a#cs) ! i))
          ‹slice_edges S cs (a#as) = [] kind a = Q:rpfs
          S,kind  (sourcenode a#xs,s) =a#as'τ (m'#ms',s')
          xs = targetnodes rs
          apply(rule_tac x="xs" in exI)
          apply(rule_tac x="sourcenode a#xs" in exI)
          apply(rule_tac x="s" in exI)
          apply(rule_tac x="a#as'" in exI)
          apply(rule_tac x="ms'" in exI)
          apply(rule_tac x="[]" in exI)
          by auto
      next
        fix S' f msx sx asx msx' sx' asx' msx'' sx''
        assume [simp]:"S = S'" and "kind = f" and "targetnode a # ms = msx"
          and "transfer (kind a) s = sx" 
          and "slice_edges S (a#cs) as = last asx # asx'"
          and "ms'' = msx''" and "s'' = sx''" 
          and "S',f  (msx,sx) =asx (msx',sx')"
          and "S',f  (msx',sx') =asx'⇒* (msx'',sx'')"
        from kind = f have [simp]:"f = kind" by simp
        from S,kind  (sourcenode a#xs,s) -aτ 
          (targetnode a#targetnode a'#xs,transfer (kind a) s)
          S',f  (msx,sx) =asx (msx',sx') x = targetnode a'
          ‹transfer (kind a) s = sx targetnode a # ms = msx
        have "S,kind  (sourcenode a#xs,s) =a#asx (msx',sx')"
          by(auto intro:silent_move_observable_moves)
        with S',f  (msx',sx') =asx'⇒* (msx'',sx'') ms'' = msx'' s'' = sx''
        have "S,kind  (sourcenode a#xs,s) =last (a#asx)#asx'⇒* (ms'',s'')"
          by(fastforce intro:trans_observable_moves.tom_Cons)
        moreover
        from S',f  (msx,sx) =asx (msx',sx') have "asx  []"
          by(fastforce elim:observable_moves.cases)
        with ‹slice_edges S cs (a#as) = slice_edges S (a#cs) as
          ‹slice_edges S (a#cs) as = last asx # asx'
        have "slice_edges S cs (a#as) = last (a#asx)#asx'" by simp
        moreover
        from ¬ slice_edge S cs a kind a = Q:rpfs
          ‹slice_edges S (a#cs) as = slice_edges S (a#cs) as''
        have "slice_edges S cs (a # as) = slice_edges S cs (a # as'')" by simp
        ultimately show ?thesis using paths m = sourcenode a kind a = Q:rpfs
          ‹length ms = length (a#cs) xs = targetnodes rs valid_edge a
          apply(rule_tac x="xs" in exI)
          apply(rule_tac x="ms''" in exI)
          apply(rule_tac x="s''" in exI)
          apply(rule_tac x="as'" in exI)
          apply(rule_tac x="ms'" in exI)
          apply(rule_tac x="a#as''" in exI)
          by(auto intro:Cons_path simp:targetnodes_def)
      qed
    qed
  next
    case (vpa_ReturnEmpty cs a as Q p f)
    from ‹preds (kinds (a # as)) s ‹length s = Suc (length cs) kind a = Qpf
      cs = []
    have False by(cases s)(auto simp:kinds_def)
    thus ?case by simp
  next
    case (vpa_ReturnCons cs a as Q p f c' cs')
    note IH = m s rs. m -as→* m'; preds (kinds as) s; transfers (kinds as) s = s';
      valid_call_list cs' m; i<length rs. rs ! i  get_return_edges (cs' ! i);
      valid_return_list rs m; length rs = length cs'; length s = Suc (length cs')
       ms ms'' s'' as' ms' as''.
      S,kind  (m # ms,s) =slice_edges S cs' as⇒* (ms'',s'') 
      S,kind  (ms'',s'') =as'τ (m' # ms',s')  ms = targetnodes rs 
      length ms = length cs' 
      (i<length cs'. call_of_return_node (ms ! i) (sourcenode (cs' ! i))) 
      slice_edges S cs' as = slice_edges S cs' as'' 
      m -as'' @ as'→* m'  valid_path_aux cs' (as'' @ as')
    from m -a # as→* m' have "m = sourcenode a" and "valid_edge a"
      and "targetnode a -as→* m'" by(auto elim:path_split_Cons)
    from ‹preds (kinds (a # as)) s have "pred (kind a) s"
      and "preds (kinds as) (transfer (kind a) s)" by(auto simp:kinds_def)
    from ‹transfers (kinds (a # as)) s = s'
    have "transfers (kinds as) (transfer (kind a) s) = s'" by(fastforce simp:kinds_def)
    from ‹valid_call_list cs m cs = c' # cs' have "valid_edge c'"
      by(fastforce simp:valid_call_list_def)
    from valid_edge c' a  get_return_edges c'
    have "get_proc (sourcenode c') = get_proc (targetnode a)"
      by(rule get_proc_get_return_edge)
    from ‹valid_call_list cs m cs = c' # cs'
      get_proc (sourcenode c') = get_proc (targetnode a)
    have "valid_call_list cs' (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(hypsubst_thin)
      apply(erule_tac x="c' # cs'" in allE)
      by(case_tac cs')(auto simp:sourcenodes_def)
    from ‹length rs = length cs cs = c' # cs' obtain r' rs' 
      where [simp]:"rs = r'#rs'" and "length rs' = length cs'" by(cases rs) auto
    from i<length rs. rs ! i  get_return_edges (cs ! i) cs = c' # cs'
    have "i<length rs'. rs' ! i  get_return_edges (cs' ! i)"
      and "r'  get_return_edges c'" by auto
    with valid_edge c' a  get_return_edges c' have [simp]:"a = r'" 
      by -(rule get_return_edges_unique)
    with ‹valid_return_list rs m 
    have "valid_return_list rs' (targetnode a)"
      apply(clarsimp simp:valid_return_list_def)
      apply(erule_tac x="r' # cs'" in allE)
      by(case_tac cs')(auto simp:targetnodes_def)
    from ‹length s = Suc (length cs) cs = c' # cs' kind a = Qpf
    have "length (transfer (kind a) s) = Suc (length cs')"
      by(cases s)(auto,case_tac list,auto)
    from IH[OF targetnode a -as→* m' ‹preds (kinds as) (transfer (kind a) s)
      ‹transfers (kinds as) (transfer (kind a) s) = s'
      ‹valid_call_list cs' (targetnode a) 
      i<length rs'. rs' ! i  get_return_edges (cs' ! i)
      ‹valid_return_list rs' (targetnode a) ‹length rs' = length cs' this]
    obtain ms ms'' s'' as' ms' as'' where "length ms = length cs'"
      and "S,kind  (targetnode a # ms,transfer (kind a) s) 
                     =slice_edges S cs' as⇒* (ms'',s'')" 
      and paths:"S,kind  (ms'',s'') =as'τ (m' # ms',s')"
      "ms = targetnodes rs'"
      "i<length cs'. call_of_return_node (ms ! i) (sourcenode (cs' ! i))"
      "slice_edges S cs' as = slice_edges S cs' as''"
      "targetnode a -as'' @ as'→* m'" "valid_path_aux cs' (as'' @ as')"
      by blast
    from i<length cs'. call_of_return_node (ms ! i) (sourcenode (cs' ! i))
      ‹length ms = length cs'
    have "mx  set ms. return_node mx"
      by(auto simp:in_set_conv_nth call_of_return_node_def)
    from valid_edge a valid_edge c' a  get_return_edges c'
    have "return_node (targetnode a)" by(fastforce simp:return_node_def)
    with valid_edge c' valid_edge a a  get_return_edges c'
    have "call_of_return_node (targetnode a) (sourcenode c')"
      by(simp add:call_of_return_node_def) blast
    show ?case
    proof(cases "(m  set (targetnode a#ms). m'. call_of_return_node m m'  
        m'  HRB_slice SCFG)")
      case True
      then obtain x where "call_of_return_node (targetnode a) x"
        and "x  HRB_slice SCFG" by fastforce
      with ‹call_of_return_node (targetnode a) (sourcenode c')
      have "sourcenode c'  HRB_slice SCFG" by fastforce
      with True i<length cs'. call_of_return_node (ms ! i) (sourcenode (cs' ! i))
        ‹length ms = length cs' cs = c' # cs' kind a = Qpf
      have "slice_edge S cs a"
        apply(auto simp:slice_edge_def in_set_conv_nth) 
        by(erule_tac x="i" in allE) auto
      with kind a = Qpf cs = c' # cs'
      have "slice_edges S cs (a#as) = a#slice_edges S cs' as" by simp
      from True ‹pred (kind a) s valid_edge a kind a = Qpf
        mx  set ms. return_node mx ‹length ms = length cs' 
        ‹length s = Suc (length cs) m = sourcenode a
        ‹length (transfer (kind a) s) = Suc (length cs')
        ‹return_node (targetnode a) cs = c' # cs'
      have "S,kind  (sourcenode a#targetnode a#ms,s) -a 
        (targetnode a#ms,transfer (kind a) s)"
        by(auto intro!:observable_move_return)
      with ‹length ms = length cs' ‹length s = Suc (length cs) cs = c' # cs'
      have "S,kind  (sourcenode a#targetnode a#ms,s) =[]@[a]
        (targetnode a#ms,transfer (kind a) s)"
        by(fastforce intro:observable_moves_snoc silent_moves_Nil)
      with S,kind  (targetnode a # ms,transfer (kind a) s) 
                     =slice_edges S cs' as⇒* (ms'',s'')
      have "S,kind  (sourcenode a#targetnode a#ms,s) 
        =last [a]#slice_edges S cs' as⇒* (ms'',s'')"
        by -(rule tom_Cons,auto)
      with ‹slice_edges S cs (a#as) = a#slice_edges S cs' as
      have "S,kind  (sourcenode a#targetnode a#ms,s) =slice_edges S cs (a#as)⇒* 
        (ms'',s'')" by simp
      moreover
      from ‹slice_edges S cs' as = slice_edges S cs' as''
        ‹slice_edge S cs a kind a = Qpf cs = c' # cs'
      have "slice_edges S cs (a#as) = slice_edges S cs (a#as'')" by simp
      ultimately show ?thesis
        using paths m = sourcenode a valid_edge a kind a = Qpf
          ‹length ms = length cs' ms = targetnodes rs' cs = c' # cs'
          ‹slice_edges S cs (a#as) = a#slice_edges S cs' as
          a  get_return_edges c' 
          ‹call_of_return_node (targetnode a) (sourcenode c')
        apply(rule_tac x="targetnode a#ms" in exI)
        apply(rule_tac x="ms''" in exI)
        apply(rule_tac x="s''" in exI)
        apply(rule_tac x="as'" in exI)
        apply(rule_tac x="ms'" in exI)
        apply(rule_tac x="a#as''" in exI)
        apply(auto intro:Cons_path simp:targetnodes_def)
        by(case_tac i) auto
    next
      case False
      with mx  set ms. return_node mx ‹return_node (targetnode a)
      have "m  set (targetnode a # ms). m'. call_of_return_node m m'  
        m'  HRB_slice SCFG"
        by(fastforce dest:return_node_call_of_return_node)
      with i<length cs'. call_of_return_node (ms ! i) (sourcenode (cs' ! i))
        ‹length ms = length cs' cs = c' # cs' kind a = Qpf
        ‹call_of_return_node (targetnode a) (sourcenode c')
      have "¬ slice_edge S cs a"
        apply(auto simp:slice_edge_def in_set_conv_nth)
        by(erule_tac x="i" in allE) auto
      with kind a = Qpf cs = c' # cs'
      have "slice_edges S cs (a#as) = slice_edges S cs' as" by simp
      from ‹pred (kind a) s valid_edge a kind a = Qpf
        mx  set ms. return_node mx ‹length ms = length cs' 
        ‹length s = Suc (length cs) m = sourcenode a
        ‹length (transfer (kind a) s) = Suc (length cs')
        ‹return_node (targetnode a) cs = c' # cs'
        m  set (targetnode a # ms). m'. call_of_return_node m m'  
        m'  HRB_slice SCFG
      have "S,kind  (sourcenode a#targetnode a#ms,s) -aτ
        (targetnode a#ms,transfer (kind a) s)"
        by(auto intro!:silent_move_return)
      from S,kind  (targetnode a # ms,transfer (kind a) s) 
                     =slice_edges S cs' as⇒* (ms'',s'')
      show ?thesis
      proof(rule trans_observable_moves.cases)
        fix msx sx S' f'
        assume "targetnode a # ms = msx"
          and "transfer (kind a) s = sx" and "slice_edges S cs' as = []"
          and [simp]:"ms'' = msx" "s'' = sx" and "length msx = length sx"
        from ‹slice_edges S cs (a#as) = slice_edges S cs' as 
          ‹slice_edges S cs' as = []
        have "slice_edges S cs (a#as) = []" by simp
        with ‹length ms = length cs' ‹length s = Suc (length cs) cs = c' # cs'
        have "S,kind  (sourcenode a#targetnode a#ms,s) =slice_edges S cs (a#as)⇒*
                        (sourcenode a#targetnode a#ms,s)"
          by(fastforce intro:tom_Nil)
        moreover
        from S,kind  (ms'',s'') =as'τ (m'#ms',s') targetnode a # ms = msx
          ‹transfer (kind a) s = sx ms'' = msx s'' = sx
          S,kind  (sourcenode a#targetnode a#ms,s) -aτ 
          (targetnode a#ms,transfer (kind a) s)
        have "S,kind  (sourcenode a#targetnode a#ms,s) =a#as'τ (m'#ms',s')"
          by(auto intro:silent_moves_Cons)
        from this valid_edge a 
          i<length rs. rs ! i  get_return_edges (cs ! i)
          ‹valid_return_list rs m ‹length rs = length cs
          ‹length s = Suc (length cs) m = sourcenode a
          ms = targetnodes rs' rs = r'#rs' cs = c' # cs'
        have "sourcenode a -a#as'→* m'" and "valid_path_aux cs (a#as')"
          by -(rule silent_moves_vpa_path,(fastforce simp:targetnodes_def)+)+
        ultimately show ?thesis using m = sourcenode a ‹length ms = length cs'
          i<length cs'. call_of_return_node (ms ! i) (sourcenode (cs' ! i))
          ‹slice_edges S cs (a#as) = [] kind a = Qpf
          S,kind  (sourcenode a#targetnode a#ms,s) =a#as'τ (m'#ms',s')
          ms = targetnodes rs' rs = r'#rs' cs = c' # cs'
          ‹call_of_return_node (targetnode a) (sourcenode c')
          apply(rule_tac x="targetnode a#ms" in exI)
          apply(rule_tac x="sourcenode a#targetnode a#ms" in exI)
          apply(rule_tac x="s" in exI)
          apply(rule_tac x="a#as'" in exI)
          apply(rule_tac x="ms'" in exI)
          apply(rule_tac x="[]" in exI)
          apply(auto simp:targetnodes_def)
          by(case_tac i) auto
      next
        fix S' f' msx sx asx msx' sx' asx' msx'' sx''
        assume [simp]:"S = S'" and "kind = f'" and "targetnode a # ms = msx"
          and "transfer (kind a) s = sx" 
          and "slice_edges S cs' as = last asx # asx'"
          and "ms'' = msx''" and "s'' = sx''" 
          and "S',f'  (msx,sx) =asx (msx',sx')"
          and "S',f'  (msx',sx') =asx'⇒* (msx'',sx'')"
        from kind = f' have [simp]:"f' = kind" by simp
        from S,kind  (sourcenode a#targetnode a#ms,s) -aτ 
          (targetnode a#ms,transfer (kind a) s)
          S',f'  (msx,sx) =asx (msx',sx')
          ‹transfer (kind a) s = sx targetnode a # ms = msx
        have "S,kind  (sourcenode a#targetnode a#ms,s) =a#asx (msx',sx')"
          by(auto intro:silent_move_observable_moves)
        with S',f'  (msx',sx') =asx'⇒* (msx'',sx'') ms'' = msx'' s'' = sx''
        have "S,kind  (sourcenode a#targetnode a#ms,s) =last (a#asx)#asx'⇒* 
          (ms'',s'')"
          by(fastforce intro:trans_observable_moves.tom_Cons)
        moreover
        from S',f'  (msx,sx) =asx (msx',sx') have "asx  []"
          by(fastforce elim:observable_moves.cases)
        with ‹slice_edges S cs (a#as) = slice_edges S cs' as
          ‹slice_edges S cs' as = last asx # asx'
        have "slice_edges S cs (a#as) = last (a#asx)#asx'" by simp
        moreover
        from ¬ slice_edge S cs a kind a = Qpf
          ‹slice_edges S cs' as = slice_edges S cs' as'' cs = c' # cs'
        have "slice_edges S cs (a # as) = slice_edges S cs (a # as'')" by simp
        ultimately show ?thesis using paths m = sourcenode a kind a = Qpf
          ‹length ms = length cs' ms = targetnodes rs' valid_edge a
          rs = r'#rs' cs = c' # cs' r'  get_return_edges c'
          ‹call_of_return_node (targetnode a) (sourcenode c')
          apply(rule_tac x="targetnode a#ms" in exI)
          apply(rule_tac x="ms''" in exI)
          apply(rule_tac x="s''" in exI)
          apply(rule_tac x="as'" in exI)
          apply(rule_tac x="ms'" in exI)
          apply(rule_tac x="a#as''" in exI)
          apply(auto intro:Cons_path simp:targetnodes_def)
          by(case_tac i) auto
      qed
    qed
  qed
qed



lemma valid_path_trans_observable_moves:
  assumes "m -as* m'" and "preds (kinds as) [cf]" 
  and "transfers (kinds as) [cf] = s'"
  obtains ms'' s'' ms' as' as'' 
  where "S,kind  ([m],[cf]) =slice_edges S [] as⇒* (ms'',s'')"
  and "S,kind  (ms'',s'') =as'τ (m'#ms',s')"
  and "slice_edges S [] as = slice_edges S [] as''"
  and "m -as''@as'* m'"
proof(atomize_elim)
  from m -as* m' have "valid_path_aux [] as" and "m -as→* m'"
    by(simp_all add:vp_def valid_path_def)
  from this ‹preds (kinds as) [cf] ‹transfers (kinds as) [cf] = s'
  show "ms'' s'' as' ms' as''. 
    S,kind  ([m],[cf]) =slice_edges S [] as⇒* (ms'',s'') 
    S,kind  (ms'',s'') =as'τ (m' # ms',s') 
    slice_edges S [] as = slice_edges S [] as''  m -as'' @ as'* m'"
    by -(erule vpa_trans_observable_moves[of _ _ _ _ _ _ "[]" S],
      auto simp:valid_call_list_def valid_return_list_def vp_def valid_path_def)
qed


lemma WS_weak_sim_trans:
  assumes "((ms1,s1),(ms2,s2))  WS S"
  and "S,kind  (ms1,s1) =as⇒* (ms1',s1')" and "as  []"
  shows "((ms1',s1'),(ms1',transfers (slice_kinds S as) s2))  WS S  
         S,slice_kind S  (ms2,s2) =as⇒* (ms1',transfers (slice_kinds S as) s2)"
proof -
  obtain f where "f = kind" by simp
  with S,kind  (ms1,s1) =as⇒* (ms1',s1') 
  have "S,f  (ms1,s1) =as⇒* (ms1',s1')" by simp
  from S,f  (ms1,s1) =as⇒* (ms1',s1') ((ms1,s1),(ms2,s2))  WS S 
    as  [] f = kind
  show ?thesis
  proof(induct arbitrary:ms2 s2 rule:trans_observable_moves.induct)
    case tom_Nil thus ?case by simp
  next
    case (tom_Cons S f ms s as ms' s' as' ms'' s'')
    note IH = ms2 s2. ((ms',s'),(ms2,s2))  WS S; as'  []; f = kind
       ((ms'',s''),(ms'',transfers (slice_kinds S as') s2))  WS S 
      S,slice_kind S  (ms2,s2) =as'⇒* (ms'',transfers (slice_kinds S as') s2)
    from S,f  (ms,s) =as (ms',s') have "s'  []"
      by(fastforce elim:observable_moves.cases observable_move.cases)
    from S,f  (ms,s) =as (ms',s')
    obtain asx ax msx sx where "S,f  (ms,s) =asxτ (msx,sx)"
      and "S,f  (msx,sx) -ax (ms',s')" and "as = asx@[ax]"
      by(fastforce elim:observable_moves.cases)
    from S,f  (ms,s) =asxτ (msx,sx) ((ms,s),(ms2,s2))  WS S f = kind
    have "((msx,sx),(ms2,s2))  WS S" by(fastforce intro:WS_silent_moves)
    from ((msx,sx),(ms2,s2))  WS S S,f  (msx,sx) -ax (ms',s') s'  []
      f = kind
    obtain asx' where "((ms',s'),(ms',transfer (slice_kind S ax) s2))  WS S"
      and "S,slice_kind S  (ms2,s2) =asx'@[ax] 
      (ms',transfer (slice_kind S ax) s2)"
      by(fastforce elim:WS_observable_move)
    show ?case
    proof(cases "as' = []")
      case True
      with S,f  (ms',s') =as'⇒* (ms'',s'') have "ms' = ms''  s' = s''"
        by(fastforce elim:trans_observable_moves.cases dest:observable_move_notempty)
      from ((ms',s'),(ms',transfer (slice_kind S ax) s2))  WS S
      have "length ms' = length (transfer (slice_kind S ax) s2)"
        by(fastforce elim:WS.cases)
      with S,slice_kind S  (ms2,s2) =asx'@[ax] 
        (ms',transfer (slice_kind S ax) s2)
      have "S,slice_kind S  (ms2,s2) =(last (asx'@[ax]))#[]⇒* 
        (ms',transfer (slice_kind S ax) s2)"
        by(fastforce intro:trans_observable_moves.intros)
      with ((ms',s'),(ms',transfer (slice_kind S ax) s2))  WS S as = asx@[ax]
        ms' = ms''  s' = s'' True
      show ?thesis by(fastforce simp:slice_kinds_def)
    next
      case False
      from IH[OF ((ms',s'),(ms',transfer (slice_kind S ax) s2))  WS S this 
        f = kind]
      have "((ms'',s''),(ms'',transfers (slice_kinds S as') 
        (transfer (slice_kind S ax) s2)))  WS S"
        and "S,slice_kind S  (ms',transfer (slice_kind S ax) s2) =as'⇒* 
        (ms'',transfers (slice_kinds S as') (transfer (slice_kind S ax) s2))" 
        by simp_all
      with S,slice_kind S  (ms2,s2) =asx'@[ax] 
                               (ms',transfer (slice_kind S ax) s2)
      have "S,slice_kind S  (ms2,s2) =(last (asx'@[ax]))#as'⇒* 
        (ms'',transfers (slice_kinds S as') (transfer (slice_kind S ax) s2))"
        by(fastforce intro:trans_observable_moves.tom_Cons)
      with ((ms'',s''),(ms'',transfers (slice_kinds S as') 
        (transfer (slice_kind S ax) s2)))  WS S False as = asx@[ax]
      show ?thesis by(fastforce simp:slice_kinds_def)
    qed
  qed
qed


lemma stacks_rewrite:
  assumes "valid_call_list cs m" and "valid_return_list rs m"
  and "i < length rs. rs!i  get_return_edges (cs!i)"
  and "length rs = length cs" and "ms = targetnodes rs"
  shows "i<length cs. call_of_return_node (ms!i) (sourcenode (cs!i))"
proof
  fix i show "i < length cs 
    call_of_return_node (ms ! i) (sourcenode (cs ! i))"
  proof
    assume "i < length cs"
    with i < length rs. rs!i  get_return_edges (cs!i) ‹length rs = length cs
    have "rs!i  get_return_edges (cs!i)" by fastforce
    from ‹valid_return_list rs m have "r  set rs. valid_edge r"
      by(rule valid_return_list_valid_edges)
    with i < length cs ‹length rs = length cs
    have "valid_edge (rs!i)" by(simp add:all_set_conv_all_nth)
    from ‹valid_call_list cs m have "c  set cs. valid_edge c"
      by(rule valid_call_list_valid_edges)
    with i < length cs have "valid_edge (cs!i)" by(simp add:all_set_conv_all_nth)
    with valid_edge (rs!i) rs!i  get_return_edges (cs!i) ms = targetnodes rs
      i < length cs ‹length rs = length cs
    show "call_of_return_node (ms ! i) (sourcenode (cs ! i))"
      by(fastforce simp:call_of_return_node_def return_node_def targetnodes_def)
  qed
qed


lemma slice_tom_preds_vp:
  assumes "S,slice_kind S  (m#ms,s) =as⇒* (m'#ms',s')" and "valid_node m"
  and "valid_call_list cs m" and "i < length rs. rs!i  get_return_edges (cs!i)"
  and "valid_return_list rs m" and "length rs = length cs" and "ms = targetnodes rs"
  and "mx  set ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG"
  obtains as' cs' rs' where "preds (slice_kinds S as') s" 
  and "slice_edges S cs as' = as" and "m -as'→* m'" and "valid_path_aux cs as'" 
  and "upd_cs cs as' = cs'" and "valid_node m'" and "valid_call_list cs' m'" 
  and "i < length rs'. rs'!i  get_return_edges (cs'!i)"
  and "valid_return_list rs' m'" and "length rs' = length cs'" 
  and "ms' = targetnodes rs'" and "transfers (slice_kinds S as') s  []"
  and "transfers (slice_kinds S (slice_edges S cs as')) s =
    transfers (slice_kinds S as') s"
proof(atomize_elim)
  from assms show "as' cs' rs'. preds (slice_kinds S as') s 
    slice_edges S cs as' = as  m -as'→* m'  valid_path_aux cs as' 
    upd_cs cs as' = cs'  valid_node m'  valid_call_list cs' m' 
    (i<length rs'. rs' ! i  get_return_edges (cs' ! i))  valid_return_list rs' m' 
    length rs' = length cs'  ms' = targetnodes rs'  
    transfers (slice_kinds S as') s  []  
    transfers (slice_kinds S (slice_edges S cs as')) s =
    transfers (slice_kinds S as') s"
  proof(induct S "slice_kind S" "m#ms" s as "m'#ms'" s'
    arbitrary:m ms cs rs rule:trans_observable_moves.induct)
    case (tom_Nil s nc)
    from ‹length (m' # ms') = length s have "s  []" by(cases s) auto
    have "preds (slice_kinds S []) s" by(fastforce simp:slice_kinds_def)
    moreover
    have "slice_edges S cs [] = []" by simp
    moreover
    from ‹valid_node m' have "m' -[]→* m'" by(fastforce intro:empty_path)
    moreover
    have "valid_path_aux cs []" by simp
    moreover
    have "upd_cs cs [] = cs" by simp
    ultimately show ?case using ‹valid_call_list cs m' ‹valid_return_list rs m' 
      i<length rs. rs ! i  get_return_edges (cs ! i) ‹length rs = length cs
      ms' = targetnodes rs s  [] ‹valid_node m'
      apply(rule_tac x="[]" in exI)
      apply(rule_tac x="cs" in exI)
      apply(rule_tac x="rs" in exI)
      by(clarsimp simp:slice_kinds_def)
  next
    case (tom_Cons S s as msx' s' as' sx'')
    note IH = m ms cs rs. msx' = m # ms; valid_node m; valid_call_list cs m;
      i<length rs. rs ! i  get_return_edges (cs ! i); valid_return_list rs m;
      length rs = length cs; ms = targetnodes rs; 
      mxset ms. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
       as'' cs' rs'. preds (slice_kinds S as'') s' 
      slice_edges S cs as'' = as'  m -as''→* m'  valid_path_aux cs as'' 
      upd_cs cs as'' = cs'  valid_node m'  valid_call_list cs' m' 
      (i<length rs'. rs' ! i  get_return_edges (cs' ! i)) 
      valid_return_list rs' m'  length rs' = length cs'  ms' = targetnodes rs' 
      transfers (slice_kinds S as'') s'  []  
      transfers (slice_kinds S (slice_edges S cs as'')) s' =
      transfers (slice_kinds S as'') s'
    note callstack = mxset ms.
      mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG
    from S,slice_kind S  (m # ms,s) =as (msx',s')
    obtain asx ax xs s'' where "as = asx@[ax]" 
      and "S,slice_kind S  (m#ms,s) =asxτ (xs,s'')" 
      and "S,slice_kind S  (xs,s'') -ax (msx',s')"
      by(fastforce elim:observable_moves.cases)
    from S,slice_kind S  (xs,s'') -ax (msx',s')
    obtain xs' ms'' where [simp]:"xs = sourcenode ax#xs'" "msx' = targetnode ax#ms''"
      by (cases xs) (auto elim!:observable_move.cases, cases msx', auto)
    from S,slice_kind S  (m # ms,s) =as (msx',s') tom_Cons
    obtain cs'' rs'' where results:"valid_node (targetnode ax)"
      "valid_call_list cs'' (targetnode ax)"
      "i < length rs''. rs''!i  get_return_edges (cs''!i)"
      "valid_return_list rs'' (targetnode ax)" "length rs'' = length cs''" 
      "ms'' = targetnodes rs''" and "upd_cs cs as = cs''"
      by(auto elim!:observable_moves_preserves_stack)
    from S,slice_kind S  (m#ms,s) =asxτ (xs,s'') callstack
    have "a  set asx. intra_kind (kind a)"
      by simp(rule silent_moves_slice_intra_path)
    with S,slice_kind S  (m#ms,s) =asxτ (xs,s'')
    have [simp]:"xs' = ms" by(fastforce dest:silent_moves_intra_path)
    from S,slice_kind S  (xs,s'') -ax (msx',s')
    have "mx  set ms''. mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG"
      by(fastforce dest:observable_set_stack_in_slice)
    from IH[OF msx' = targetnode ax#ms'' results this]
    obtain asx' cs' rs' where "preds (slice_kinds S asx') s'" 
      and "slice_edges S cs'' asx' = as'" and "targetnode ax -asx'→* m'"
      and "valid_path_aux cs'' asx'" and "upd_cs cs'' asx' = cs'"
      and "valid_node m'" and "valid_call_list cs' m'" 
      and "i<length rs'. rs' ! i  get_return_edges (cs' ! i)"
      and "valid_return_list rs' m'" and "length rs' = length cs'"
      and "ms' = targetnodes rs'" and "transfers (slice_kinds S asx') s'  []"
      and trans_eq:"transfers (slice_kinds S (slice_edges S cs'' asx')) s' =
      transfers (slice_kinds S asx') s'"
      by blast
    from S,slice_kind S  (m#ms,s) =asxτ (xs,s'')
    have "preds (slice_kinds S asx) s" and "transfers (slice_kinds S asx) s = s''"
      by(auto intro:silent_moves_preds_transfers simp:slice_kinds_def)
    from S,slice_kind S  (xs,s'') -ax (msx',s')
    have "pred (slice_kind S ax) s''" and "transfer (slice_kind S ax) s'' = s'"
      by(auto elim:observable_move.cases)
    with ‹preds (slice_kinds S asx) s as = asx@[ax]
      ‹transfers (slice_kinds S asx) s = s''
    have "preds (slice_kinds S as) s" by(simp add:preds_split slice_kinds_def)
    from ‹transfers (slice_kinds S asx) s = s'' 
      ‹transfer (slice_kind S ax) s'' = s' as = asx@[ax]
    have "transfers (slice_kinds S as) s = s'" 
      by(simp add:transfers_split slice_kinds_def)
    with ‹preds (slice_kinds S asx') s' ‹preds (slice_kinds S as) s
    have "preds (slice_kinds S (as@asx')) s" by(simp add:preds_split slice_kinds_def)
    moreover
    from ‹valid_call_list cs m ‹valid_return_list rs m
      i<length rs. rs ! i  get_return_edges (cs ! i) ‹length rs = length cs
      ms = targetnodes rs
    have "i<length cs. call_of_return_node (ms!i) (sourcenode (cs!i))"
      by(rule stacks_rewrite)
    with S,slice_kind S  (m # ms,s) =as (msx',s') ms = targetnodes rs
      ‹length rs = length cs
    have "slice_edges S cs as = [last as]"
      by(fastforce elim:observable_moves_singular_slice_edge)
    with ‹slice_edges S cs'' asx' = as' ‹upd_cs cs as = cs''
    have "slice_edges S cs (as@asx') = [last as]@as'"
      by(fastforce intro:slice_edges_Append)
    moreover
    from S,slice_kind S  (m#ms,s) =asxτ (xs,s'') ‹valid_node m
      ‹valid_call_list cs m i<length rs. rs ! i  get_return_edges (cs ! i)
      ‹valid_return_list rs m ‹length rs = length cs ms = targetnodes rs
    have "m -asx→* sourcenode ax" by(fastforce intro:silent_moves_vpa_path)
    from S,slice_kind S  (xs,s'') -ax (msx',s') have "valid_edge ax"
      by(fastforce elim:observable_move.cases)
    hence "sourcenode ax -[ax]→* targetnode ax" by(rule path_edge)
    with m -asx→* sourcenode ax as = asx@[ax]
    have "m -as→* targetnode ax" by(fastforce intro:path_Append)
    with targetnode ax -asx'→* m' have "m -as@asx'→* m'"
      by -(rule path_Append)
    moreover
    from a  set asx. intra_kind (kind a) have "valid_path_aux cs asx"
      by(rule valid_path_aux_intra_path)
    from a  set asx. intra_kind (kind a) have "upd_cs cs asx = cs"
      by(rule upd_cs_intra_path)
    from m -asx→* sourcenode ax a  set asx. intra_kind (kind a)
    have "get_proc m = get_proc (sourcenode ax)"
      by(fastforce intro:intra_path_get_procs simp:intra_path_def)
    with ‹valid_return_list rs m have "valid_return_list rs (sourcenode ax)"
      apply(clarsimp simp:valid_return_list_def)
      apply(erule_tac x="cs'" in allE) apply clarsimp
      by(case_tac cs') auto
    with S,slice_kind S  (xs,s'') -ax (msx',s') valid_edge ax 
      i<length rs. rs ! i  get_return_edges (cs ! i) ms = targetnodes rs
      ‹length rs = length cs
    have "valid_path_aux cs [ax]"
      by(auto intro!:observable_move_vpa_path simp del:valid_path_aux.simps)
    with ‹valid_path_aux cs asx ‹upd_cs cs asx = cs as = asx@[ax]
    have "valid_path_aux cs as" by(fastforce intro:valid_path_aux_Append)
    with ‹upd_cs cs as = cs'' ‹valid_path_aux cs'' asx'
    have "valid_path_aux cs (as@asx')" by(fastforce intro:valid_path_aux_Append)
    moreover
    from ‹upd_cs cs as = cs'' ‹upd_cs cs'' asx' = cs'
    have "upd_cs cs (as@asx') = cs'" by(rule upd_cs_Append)
    moreover
    from ‹transfers (slice_kinds S as) s = s' 
      ‹transfers (slice_kinds S asx') s'  []
    have "transfers (slice_kinds S (as@asx')) s  []"
      by(simp add:slice_kinds_def transfers_split)
    moreover
    from S,slice_kind S  (m # ms,s) =as (msx',s')
    have "transfers (map (slice_kind S) as) s = s'"
      by simp(rule observable_moves_preds_transfers)
    from S,slice_kind S  (m # ms,s) =as (msx',s') ms = targetnodes rs
      ‹length rs = length cs i<length rs. rs ! i  get_return_edges (cs ! i)
      ‹valid_call_list cs m ‹valid_return_list rs m
    have "slice_edges S cs as = [last as]"
      by(fastforce intro!:observable_moves_singular_slice_edge
      [OF _ _ _ stacks_rewrite])
    from S,slice_kind S  (m#ms,s) =asxτ (xs,s'') callstack
    have "s = s''" by(fastforce intro:silent_moves_slice_keeps_state)
    with S,slice_kind S  (xs,s'') -ax (msx',s')
    have "transfer (slice_kind S ax) s = s'" by(fastforce elim:observable_move.cases)
    with ‹slice_edges S cs as = [last as] as = asx@[ax]
    have "s' = transfers (slice_kinds S (slice_edges S cs as)) s"
      by(simp add:slice_kinds_def)
    from ‹upd_cs cs as = cs''
    have "slice_edges S cs (as @ asx') =
      (slice_edges S cs as)@(slice_edges S cs'' asx')"
      by(fastforce intro:slice_edges_Append)
    hence trans_eq':"transfers (slice_kinds S (slice_edges S cs (as @ asx'))) s =
      transfers (slice_kinds S (slice_edges S cs'' asx'))
        (transfers (slice_kinds S (slice_edges S cs as)) s)"
      by(simp add:slice_kinds_def transfers_split)
    from s' = transfers (slice_kinds S (slice_edges S cs as)) s
      ‹transfers (map (slice_kind S) as) s = s'
    have "transfers (map (slice_kind S) (slice_edges S cs as)) s =
      transfers (map (slice_kind S) as) s"
      by(simp add:slice_kinds_def)
    with trans_eq trans_eq'
      s' = transfers (slice_kinds S (slice_edges S cs as)) s
    have "transfers (slice_kinds S (slice_edges S cs (as @ asx'))) s =
       transfers (slice_kinds S (as @ asx')) s" 
      by(simp add:slice_kinds_def transfers_split)
    ultimately show ?case
      using ‹valid_node m' ‹valid_call_list cs' m' 
        i<length rs'. rs' ! i  get_return_edges (cs' ! i) 
        ‹valid_return_list rs' m' ‹length rs' = length cs' ms' = targetnodes rs'
      apply(rule_tac x="as@asx'" in exI)
      apply(rule_tac x="cs'" in exI)
      apply(rule_tac x="rs'" in exI)
      by clarsimp
  qed
qed


subsection ‹The fundamental property of static interprocedural slicing›

theorem fundamental_property_of_static_slicing:
  assumes "m -as* m'" and "preds (kinds as) [cf]" and "CFG_node m'  S"
  obtains as' where "preds (slice_kinds S as') [cf]"
  and "V  Use m'. state_val (transfers (slice_kinds S as') [cf]) V = 
                    state_val (transfers (kinds as) [cf]) V"
  and "slice_edges S [] as = slice_edges S [] as'"
  and "transfers (kinds as) [cf]  []" and "m -as'* m'"
proof(atomize_elim)
  from m -as* m' ‹preds (kinds as) [cf] obtain ms'' s'' ms' as' as''
    where "S,kind  ([m],[cf]) =slice_edges S [] as⇒* 
                              (ms'',s'')"
    and "S,kind  (ms'',s'') =as'τ (m'#ms',transfers (kinds as) [cf])"
    and "slice_edges S [] as = slice_edges S [] as''"
    and "m -as''@as'* m'"
    by(auto elim:valid_path_trans_observable_moves[of _ _ _ _ _ "S"])
  from m -as* m' have "valid_node m" and "valid_node m'"
    by(auto intro:path_valid_node simp:vp_def)
  with ‹CFG_node m'  S have "CFG_node m'  HRB_slice S" 
    by -(rule HRB_slice_refl)
  from ‹valid_node m ‹CFG_node m'  S have "(([m],[cf]),([m],[cf]))  WS S" 
    by(fastforce intro:WSI)
  { fix V assume "V  Use m'"
    with ‹valid_node m' have "V  UseSDG (CFG_node m')" 
      by(fastforce intro:CFG_Use_SDG_Use)
    moreover
    from ‹valid_node m' 
    have "parent_node (CFG_node m') -[]ι* parent_node (CFG_node m')" 
      by(fastforce intro:empty_path simp:intra_path_def)
    ultimately have "V  rv S (CFG_node m')"
      using ‹CFG_node m'  HRB_slice S ‹CFG_node m'  S
      by(fastforce intro:rvI simp:sourcenodes_def) }
  hence "V  Use m'. V  rv S (CFG_node m')" by simp
  show "as'. preds (slice_kinds S as') [cf] 
    (VUse m'. state_val (transfers (slice_kinds S as') [cf]) V =
    state_val (transfers (kinds as) [cf]) V)  
    slice_edges S [] as = slice_edges S [] as' 
     transfers (kinds as) [cf]  []  m -as'* m'"
  proof(cases "slice_edges S [] as = []")
    case True
    hence "preds (slice_kinds S []) [cf]" 
      and "slice_edges S [] [] = slice_edges S [] as"
      by(simp_all add:slice_kinds_def)
    with S,kind  ([m],[cf]) =slice_edges S [] as⇒* (ms'',s'')
    have [simp]:"ms'' = [m]" "s'' = [cf]" by(auto elim:trans_observable_moves.cases)
    with S,kind  (ms'',s'') =as'τ (m'#ms',transfers (kinds as) [cf])
    have "S,kind  ([m],[cf]) =as'τ (m'#ms',transfers (kinds as) [cf])"
      by simp
    with ‹valid_node m have "m -as'→* m'" and "valid_path_aux [] as'"
      by(auto intro:silent_moves_vpa_path[of _ _ _ _ _ _ _ _ _ "[]"]
               simp:targetnodes_def valid_return_list_def)
    hence "m -as'* m'" by(simp add:vp_def valid_path_def)
    from S,kind  ([m],[cf]) =as'τ (m'#ms',transfers (kinds as) [cf])
    have "slice_edges S [] as' = []"
      by(fastforce dest:silent_moves_no_slice_edges[where cs="[]" and rs="[]"]
                  simp:targetnodes_def)
    from S,kind  ([m],[cf]) =as'τ (m'#ms',transfers (kinds as) [cf])
      ‹valid_node m ‹valid_node m' ‹CFG_node m'  S
    have returns:"mx  set ms'. 
      mx'. call_of_return_node mx mx'  mx'  HRB_slice SCFG"
      by -(erule silent_moves_called_node_in_slice1_nodestack_in_slice1
        [of _ _ _ _ _ _ _ _ _ "[]" "[]"],
        auto intro:refl_slice1 simp:targetnodes_def valid_return_list_def)
    from S,kind  ([m],[cf]) =as'τ (m'#ms',transfers (kinds as) [cf])
      (([m],[cf]),([m],[cf]))  WS S
    have WS:"((m'#ms',transfers (kinds as) [cf]),([m],[cf]))  WS S"
      by(rule WS_silent_moves)
    hence "transfers (kinds as) [cf]  []" by(auto elim!:WS.cases)
    with WS returns ‹transfers (kinds as) [cf]  [] 
    have "V  rv S (CFG_node m'). 
      state_val (transfers (kinds as) [cf]) V = fst cf V"
      apply - apply(erule WS.cases) apply clarsimp
      by(case_tac msx)(auto simp:hd_conv_nth)
    with V  Use m'. V  rv S (CFG_node m')
    have Uses:"V  Use m'. state_val (transfers (kinds as) [cf]) V = fst cf V"
      by simp
    have [simp]:"ms' = []"
    proof(rule ccontr)
      assume "ms'  []"
      with S,kind  ([m],[cf]) =as'τ (m'#ms',transfers (kinds as) [cf])
        ‹valid_node m ‹valid_node m' ‹CFG_node m'  S
      show False
        by(fastforce elim:silent_moves_nonempty_nodestack_False intro:refl_slice1)
    qed
    with S,kind  ([m],[cf]) =as'τ (m'#ms',transfers (kinds as) [cf])
    have "S,kind  ([m],[cf]) =as'τ ([m'],transfers (kinds as) [cf])"
      by simp
    with ‹valid_node m have "m -as'sl* m'" by(fastforce dest:silent_moves_slp)
    from this ‹slice_edges S [] as' = [] 
    obtain asx where "m -asxι* m'" and "slice_edges S [] asx = []"
      by(erule slp_to_intra_path_with_slice_edges)
    with ‹CFG_node m'  HRB_slice S
    obtain asx' where "m -asx'ι* m'" 
      and "preds (slice_kinds S asx') [cf]"
      and "slice_edges S [] asx' = []"
      by -(erule exists_sliced_intra_path_preds,auto simp:SDG_to_CFG_set_def)
    from m -asx'ι* m' have "m -asx'* m'" by(rule intra_path_vp)
    from Uses ‹slice_edges S [] asx' = []
    have "hd (transfers (slice_kinds S 
      (slice_edges S [] asx')) [cf]) = cf" by(simp add:slice_kinds_def)
    from m -asx'ι* m' ‹CFG_node m'  S
    have "transfers (slice_kinds S (slice_edges S [] asx')) [cf] = 
      transfers (slice_kinds S asx') [cf]"
      by(fastforce intro:transfers_intra_slice_kinds_slice_edges simp:intra_path_def)
    with ‹hd (transfers (slice_kinds S (slice_edges S [] asx')) [cf]) = cf
    have "hd (transfers (slice_kinds S asx') [cf]) = cf" by simp
    with Uses have "VUse m'. state_val (transfers (slice_kinds S asx') [cf]) V =
      state_val (transfers (kinds as) [cf]) V" by simp
    with m -asx'* m' ‹preds (slice_kinds S asx') [cf]
      ‹slice_edges S [] asx' = [] ‹transfers (kinds as) [cf]  [] True
    show ?thesis by fastforce
  next
    case False
    with (([m],[cf]),([m],[cf]))  WS S
      S,kind  ([m],[cf]) =slice_edges S [] as⇒* (ms'',s'')
    have WS:"((ms'',s''),(ms'',transfers (slice_kinds S (slice_edges S [] as)) [cf]))
       WS S"
      and tom:"S,slice_kind S  ([m],[cf]) =slice_edges S [] as⇒* 
      (ms'',transfers (slice_kinds S (slice_edges S [] as)) [cf])"
      by(fastforce dest:WS_weak_sim_trans)+
    from WS obtain mx msx where [simp]:"ms'' = mx#msx" and "valid_node mx"
      by -(erule WS.cases,cases ms'',auto)
    from S,kind  (ms'',s'') =as'τ (m'#ms',transfers (kinds as) [cf]) WS 
    have WS':"((m'#ms',transfers (kinds as) [cf]),
      (mx#msx,transfers (slice_kinds S (slice_edges S [] as)) [cf]))  WS S"
      by simp(rule WS_silent_moves)
    from tom ‹valid_node m
    obtain asx csx rsx where "preds (slice_kinds S asx) [cf]"
      and "slice_edges S [] asx = slice_edges S [] as"
      and "m -asx* mx" and "transfers (slice_kinds S asx) [cf]  []"
      and "upd_cs [] asx = csx" and stack:"valid_node mx" "valid_call_list csx mx" 
      "i < length rsx. rsx!i  get_return_edges (csx!i)"
      "valid_return_list rsx mx" "length rsx = length csx" 
      "msx = targetnodes rsx"
      and trans_eq:"transfers (slice_kinds S 
      (slice_edges S [] asx)) [cf] = 
      transfers (slice_kinds S asx) [cf]"
      by(auto elim:slice_tom_preds_vp[of _ _ _ _ _ _ _ _ "[]" "[]"]
              simp:valid_call_list_def valid_return_list_def targetnodes_def 
                   vp_def valid_path_def)
    from ‹transfers (slice_kinds S asx) [cf]  []
    obtain cf' cfs' where eq:"transfers (slice_kinds S asx) [cf] = 
      cf'#cfs'" by(cases "transfers (slice_kinds S asx) [cf]") auto
    from WS' have callstack:"mx  set msx. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG"
      by(fastforce elim:WS.cases)
    with S,kind  (ms'',s'') =as'τ (m'#ms',transfers (kinds as) [cf])
      ‹valid_node m' stack ‹CFG_node m'  S
    have callstack':"mx  set ms'. mx'. call_of_return_node mx mx'  
      mx'  HRB_slice SCFG"
      by simp(erule silent_moves_called_node_in_slice1_nodestack_in_slice1
        [of _ _ _ _ _ _ _ _ _ rsx csx],auto intro:refl_slice1)
    with S,kind  (ms'',s'') =as'τ (m'#ms',transfers (kinds as) [cf])
      stack callstack
    have "mx -as'sl* m'" and "msx = ms'" by(auto dest!:silent_moves_slp)
    from S,kind  (ms'',s'') =as'τ (m'#ms',transfers (kinds as) [cf])
      stack
    have "slice_edges S csx as' = []"
      by(auto dest:silent_moves_no_slice_edges[OF _ _ _ stacks_rewrite])
    with mx -as'sl* m' obtain asx'' where "mx -asx''ι* m'"
      and "slice_edges S csx asx'' = []"
      by(erule slp_to_intra_path_with_slice_edges)
    from stack have "i<length csx. call_of_return_node (msx!i) (sourcenode (csx!i))"
      by -(rule stacks_rewrite)
    with callstack msx = targetnodes rsx ‹length rsx = length csx
    have "cset csx. sourcenode c  HRB_slice SCFG"
      by(auto simp:all_set_conv_all_nth targetnodes_def)
    with mx -asx''ι* m' ‹slice_edges S csx asx'' = [] ‹valid_node m'
      eq ‹CFG_node m'  S
    obtain asx' where "mx -asx'ι* m'"
      and "preds (slice_kinds S asx') (cf'#cfs')"
      and "slice_edges S csx asx' = []"
      by -(erule exists_sliced_intra_path_preds,
        auto intro:HRB_slice_refl simp:SDG_to_CFG_set_def)
    with eq have "preds (slice_kinds S asx') 
      (transfers (slice_kinds S asx) [cf])" by simp
    with ‹preds (slice_kinds S asx) [cf]
    have "preds (slice_kinds S (asx@asx')) [cf]"
      by(simp add:slice_kinds_def preds_split)
    from m -asx* mx mx -asx'ι* m' have "m -asx@asx'* m'"
      by(fastforce elim:vp_slp_Append intra_path_slp)
    from ‹upd_cs [] asx = csx ‹slice_edges S csx asx' = []
    have "slice_edges S [] (asx@asx') = 
      (slice_edges S [] asx)@[]"
      by(fastforce intro:slice_edges_Append)
    from mx -asx'ι* m' cset csx. sourcenode c  HRB_slice SCFG
    have trans_eq':"transfers (slice_kinds S (slice_edges S csx asx')) 
          (transfers (slice_kinds S asx) [cf]) =
      transfers (slice_kinds S asx') (transfers (slice_kinds S asx) [cf])"
      by(fastforce intro:transfers_intra_slice_kinds_slice_edges simp:intra_path_def) 
    from ‹upd_cs [] asx = csx
    have "slice_edges S [] (asx@asx') = 
      (slice_edges S [] asx)@(slice_edges S csx asx')"
      by(fastforce intro:slice_edges_Append)
    hence "transfers (slice_kinds S (slice_edges S [] (asx@asx'))) [cf] =
      transfers (slice_kinds S (slice_edges S csx asx'))
        (transfers (slice_kinds S (slice_edges S [] asx)) [cf])"
      by(simp add:slice_kinds_def transfers_split)
    with trans_eq have "transfers (slice_kinds S (slice_edges S [] (asx@asx'))) [cf] =
      transfers (slice_kinds S (slice_edges S csx asx'))
        (transfers (slice_kinds S asx) [cf])" by simp
    with trans_eq' have trans_eq'':
      "transfers (slice_kinds S (slice_edges S [] (asx@asx'))) [cf] =
      transfers (slice_kinds S (asx@asx')) [cf]" 
      by(simp add:slice_kinds_def transfers_split)
    from WS' obtain x xs where "m'#ms' = xs@x#msx"
      and "xs  []  (mx'. call_of_return_node x mx'  
      mx'  HRB_slice SCFG)"
      and rest:"i < length (mx#msx). V  rv S (CFG_node ((x#msx)!i)). 
      (fst ((transfers (kinds as) [cf])!(length xs + i))) V = 
      (fst ((transfers (slice_kinds S 
      (slice_edges S [] as)) [cf])!i)) V"
      "transfers (kinds as) [cf]  []"
      "transfers (slice_kinds S 
      (slice_edges S [] as)) [cf]  []"
      by(fastforce elim:WS.cases)
    from m'#ms' = xs@x#msx xs  []  (mx'. call_of_return_node x mx'  
      mx'  HRB_slice SCFG) callstack'
    have [simp]:"xs = []" "x = m'" "ms' = msx" by(cases xs,auto)+
    from rest have "V  rv S (CFG_node m').
      state_val (transfers (kinds as) [cf]) V = 
      state_val (transfers (slice_kinds S (slice_edges S [] as)) [cf]) V"
      by(fastforce dest:hd_conv_nth)
    with V  Use m'. V  rv S (CFG_node m') 
      ‹slice_edges S [] asx = slice_edges S [] as
    have "V  Use m'. state_val (transfers (kinds as) [cf]) V = 
      state_val (transfers (slice_kinds S (slice_edges S [] asx)) [cf]) V"
      by simp
    with ‹slice_edges S [] (asx@asx') = (slice_edges S [] asx)@[]
    have "V  Use m'. state_val (transfers (kinds as) [cf]) V = 
      state_val (transfers (slice_kinds S (slice_edges S [] (asx@asx'))) [cf]) V"
      by simp
    with trans_eq'' have "V  Use m'. state_val (transfers (kinds as) [cf]) V = 
      state_val (transfers (slice_kinds S (asx@asx')) [cf]) V"
      by simp
    with ‹preds (slice_kinds S (asx@asx')) [cf]
      m -asx@asx'* m' ‹slice_edges S [] (asx@asx') = 
      (slice_edges S [] asx)@[] ‹transfers (kinds as) [cf]  []
      ‹slice_edges S [] asx = slice_edges S [] as
    show ?thesis by fastforce
  qed
qed

end


subsection ‹The fundamental property of static interprocedural slicing related to the semantics›

locale SemanticsProperty = SDG sourcenode targetnode kind valid_edge Entry 
    get_proc get_return_edges procs Main Exit Def Use ParamDefs ParamUses +
  CFG_semantics_wf sourcenode targetnode kind valid_edge Entry 
    get_proc get_return_edges procs Main sem identifies
  for sourcenode :: "'edge  'node" and targetnode :: "'edge  'node"
  and kind :: "'edge  ('var,'val,'ret,'pname) edge_kind" 
  and valid_edge :: "'edge  bool"
  and Entry :: "'node" ("'('_Entry'_')")  and get_proc :: "'node  'pname"
  and get_return_edges :: "'edge  'edge set"
  and procs :: "('pname × 'var list × 'var list) list" and Main :: "'pname"
  and Exit::"'node"  ("'('_Exit'_')") 
  and Def :: "'node  'var set" and Use :: "'node  'var set"
  and ParamDefs :: "'node  'var list" and ParamUses :: "'node  'var set list"
  and sem :: "'com  ('var  'val) list  'com  ('var  'val) list  bool" 
    ("((1_,/_) / (1_,/_))" [0,0,0,0] 81)
  and identifies :: "'node  'com  bool" ("_  _" [51,0] 80)
begin


theorem fundamental_property_of_path_slicing_semantically:
  assumes "m  c" and "c,[cf]  c',s'"
  obtains m' as cfs' where "m -as* m'" and "m'  c'"
  and "preds (slice_kinds {CFG_node m'} as) [(cf,undefined)]"
  and "V  Use m'. 
  state_val (transfers (slice_kinds {CFG_node m'} as) [(cf,undefined)]) V = 
  state_val cfs' V" and "map fst cfs' = s'"
proof(atomize_elim) 
  from m  c c,[cf]  c',s' obtain m' as cfs' where "m -as* m'"
    and "transfers (kinds as) [(cf,undefined)] = cfs'"
    and "preds (kinds as) [(cf,undefined)]" and "m'  c'" and "map fst cfs' = s'"
    by(fastforce dest:fundamental_property)
  from m -as* m' ‹preds (kinds as) [(cf,undefined)] obtain as'
    where "preds (slice_kinds {CFG_node m'} as') [(cf,undefined)]"
    and vals:"V  Use m'. state_val (transfers (slice_kinds {CFG_node m'} as') 
    [(cf,undefined)]) V = state_val (transfers (kinds as) [(cf,undefined)]) V"
    and "m -as'* m'"
    by -(erule fundamental_property_of_static_slicing,auto)
  from ‹transfers (kinds as) [(cf,undefined)] = cfs' vals have "V  Use m'. 
    state_val (transfers (slice_kinds {CFG_node m'} as') [(cf,undefined)]) V = 
    state_val cfs' V" by simp
  with ‹preds (slice_kinds {CFG_node m'} as') [(cf,undefined)] m -as'* m' 
    m'  c' ‹map fst cfs' = s'
  show "as m' cfs'. m -as* m'  m'  c' 
    preds (slice_kinds {CFG_node m'} as) [(cf, undefined)] 
    (VUse m'. state_val (transfers (slice_kinds {CFG_node m'} as)
    [(cf, undefined)]) V = state_val cfs' V)  map fst cfs' = s'"
    by blast
qed

end

end



Theory Com

chapter ‹Instantiating the Framework with a simple While-Language using procedures›

section ‹Commands›

theory Com imports "../StaticInter/BasicDefs" begin

subsection ‹Variables and Values›

type_synonym vname = string ― ‹names for variables›
type_synonym pname = string ― ‹names for procedures›

datatype val
  = Bool bool      ― ‹Boolean value›
  | Intg int       ― ‹integer value› 

abbreviation "true == Bool True"
abbreviation "false == Bool False"


subsection ‹Expressions›

datatype bop = Eq | And | Less | Add | Sub     ― ‹names of binary operations›

datatype expr
  = Val val                                          ― ‹value›
  | Var vname                                        ― ‹local variable›
  | BinOp expr bop expr    ("_ «_» _" [80,0,81] 80)  ― ‹binary operation›


fun binop :: "bop  val  val  val option"
where "binop Eq v1 v2               = Some(Bool(v1 = v2))"
  | "binop And (Bool b1) (Bool b2)  = Some(Bool(b1  b2))"
  | "binop Less (Intg i1) (Intg i2) = Some(Bool(i1 < i2))"
  | "binop Add (Intg i1) (Intg i2)  = Some(Intg(i1 + i2))"
  | "binop Sub (Intg i1) (Intg i2)  = Some(Intg(i1 - i2))"
  | "binop bop v1 v2                = None"


subsection ‹Commands›

datatype cmd
  = Skip
  | LAss vname expr        ("_:=_" [70,70] 70)  ― ‹local assignment›
  | Seq cmd cmd            ("_;;/ _" [60,61] 60)
  | Cond expr cmd cmd      ("if '(_') _/ else _" [80,79,79] 70)
  | While expr cmd         ("while '(_') _" [80,79] 70)
  | Call pname "expr list" "vname list" 
    ― ‹Call needs procedure, actual parameters and variables for return values›



fun num_inner_nodes :: "cmd  nat" ("#:_")
where "#:Skip              = 1"
  | "#:(V:=e)              = 2"       (* additional Skip node *)
  | "#:(c1;;c2)            = #:c1 + #:c2"
  | "#:(if (b) c1 else c2) = #:c1 + #:c2 + 1"
  | "#:(while (b) c)       = #:c + 2" (* additional Skip node *)
  | "#:(Call p es rets)    = 2"       (* additional Skip (=Return) node *)


lemma num_inner_nodes_gr_0 [simp]:"#:c > 0"
by(induct c) auto

lemma [dest]:"#:c = 0  False"
by(induct c) auto


end

Theory ProcState

section ‹The state›

theory ProcState imports Com begin

fun "interpret" :: "expr  (vname  val)  val option"
where Val: "interpret (Val v) cf = Some v"
  | Var: "interpret (Var V) cf = cf V"
  | BinOp: "interpret (e1«bop»e2) cf = 
    (case interpret e1 cf of None  None
                         | Some v1  (case interpret e2 cf of None  None
                                                           | Some v2  (
      case binop bop v1 v2 of None  None | Some v  Some v)))"


abbreviation update :: "(vname  val)  vname  expr  (vname  val)"
  where "update cf V e  cf(V:=(interpret e cf))"

abbreviation state_check :: "(vname  val)  expr  val option  bool"
where "state_check cf b v  (interpret b cf = v)"

end

Theory PCFG

section ‹Definition of the CFG›

theory PCFG imports ProcState begin

definition Main :: "pname"
  where "Main = ''Main''"

datatype label = Label nat | Entry | Exit

subsection‹The CFG for every procedure›

subsubsection ‹Definition of ⊕›

fun label_incr :: "label  nat  label" ("_  _" 60)
where "(Label l)  i = Label (l + i)"
  | "Entry  i       = Entry"
  | "Exit  i        = Exit"


lemma Exit_label_incr [dest]: "Exit = n  i  n = Exit"
  by(cases n,auto)

lemma label_incr_Exit [dest]: "n  i = Exit  n = Exit"
  by(cases n,auto)

lemma Entry_label_incr [dest]: "Entry = n  i  n = Entry"
  by(cases n,auto)

lemma label_incr_Entry [dest]: "n  i = Entry  n = Entry"
  by(cases n,auto)

lemma label_incr_inj:
  "n  c = n'  c  n = n'"
by(cases n)(cases n',auto)+

lemma label_incr_simp:"n  i = m  (i + j)  n = m  j"
by(cases n,auto,cases m,auto)

lemma label_incr_simp_rev:"m  (j + i) = n  i  m  j = n"
by(cases n,auto,cases m,auto)

lemma label_incr_start_Node_smaller:
  "Label l = n  i  n = Label (l - i)"
by(cases n,auto)

lemma label_incr_start_Node_smaller_rev:
  "n  i = Label l  n = Label (l - i)"
by(cases n,auto)


lemma label_incr_ge:"Label l = n  i  l  i"
by(cases n) auto

lemma label_incr_0 [dest]:
  "Label 0 = n  i; i > 0  False" 
by(cases n) auto

lemma label_incr_0_rev [dest]:
  "n  i = Label 0; i > 0  False" 
by(cases n) auto

subsubsection ‹The edges of the procedure CFG›

text ‹Control flow information in this language is the node, to which we return
  after the calles procedure is finished.›

datatype p_edge_kind = 
  IEdge "(vname,val,pname × label,pname) edge_kind"
| CEdge "pname × expr list × vname list"


type_synonym p_edge = "(label × p_edge_kind × label)"

inductive Proc_CFG :: "cmd  label  p_edge_kind  label  bool"
("_  _ -_p _")
where

  Proc_CFG_Entry_Exit:
  "prog  Entry -IEdge (λs. False)p Exit"

| Proc_CFG_Entry:
  "prog  Entry -IEdge (λs. True)p Label 0"

| Proc_CFG_Skip: 
  "Skip  Label 0 -IEdge idp Exit"

| Proc_CFG_LAss: 
  "V:=e  Label 0 -IEdge (λcf. update cf V e)p Label 1"

| Proc_CFG_LAssSkip:
  "V:=e  Label 1 -IEdge idp Exit"

| Proc_CFG_SeqFirst:
  "c1  n -etp n'; n'  Exit  c1;;c2  n -etp n'"

| Proc_CFG_SeqConnect: 
  "c1  n -etp Exit; n  Entry  c1;;c2  n -etp Label #:c1"

| Proc_CFG_SeqSecond: 
  "c2  n -etp n'; n  Entry  c1;;c2  n  #:c1 -etp n'  #:c1"

| Proc_CFG_CondTrue:
    "if (b) c1 else c2  Label 0 
  -IEdge (λcf. state_check cf b (Some true))p Label 1"

| Proc_CFG_CondFalse:
    "if (b) c1 else c2  Label 0 -IEdge (λcf. state_check cf b (Some false))p 
                        Label (#:c1 + 1)"

| Proc_CFG_CondThen:
  "c1  n -etp n'; n  Entry  if (b) c1 else c2  n  1 -etp n'  1"

| Proc_CFG_CondElse:
  "c2  n -etp n'; n  Entry 
   if (b) c1 else c2  n  (#:c1 + 1) -etp n'  (#:c1 + 1)"

| Proc_CFG_WhileTrue:
    "while (b) c'  Label 0 -IEdge (λcf. state_check cf b (Some true))p Label 2"

| Proc_CFG_WhileFalse:
    "while (b) c'  Label 0 -IEdge (λcf. state_check cf b (Some false))p Label 1"

| Proc_CFG_WhileFalseSkip:
  "while (b) c'  Label 1 -IEdge idp Exit"

| Proc_CFG_WhileBody:
  "c'  n -etp n'; n  Entry; n'  Exit 
   while (b) c'  n  2 -etp n'  2"

| Proc_CFG_WhileBodyExit:
  "c'  n -etp Exit; n  Entry  while (b) c'  n  2 -etp Label 0"

| Proc_CFG_Call:
  "Call p es rets  Label 0 -CEdge (p,es,rets)p Label 1"

| Proc_CFG_CallSkip:
  "Call p es rets  Label 1 -IEdge idp Exit"


subsubsection‹Some lemmas about the procedure CFG›

lemma Proc_CFG_Exit_no_sourcenode [dest]:
  "prog  Exit -etp n'  False"
by(induct prog n"Exit" et n' rule:Proc_CFG.induct,auto)


lemma Proc_CFG_Entry_no_targetnode [dest]:
  "prog  n -etp Entry  False"
by(induct prog n et n'"Entry" rule:Proc_CFG.induct,auto)


lemma Proc_CFG_IEdge_intra_kind:
  "prog  n -IEdge etp n'  intra_kind et"
by(induct prog n x"IEdge et" n' rule:Proc_CFG.induct,auto simp:intra_kind_def)


lemma [dest]:"prog  n -IEdge (Q:rpfs)p n'  False"
by(fastforce dest:Proc_CFG_IEdge_intra_kind simp:intra_kind_def)

lemma [dest]:"prog  n -IEdge (Qpf)p n'  False"
by(fastforce dest:Proc_CFG_IEdge_intra_kind simp:intra_kind_def)


lemma Proc_CFG_sourcelabel_less_num_nodes:
  "prog  Label l -etp n'  l < #:prog"
proof(induct prog "Label l" et n' arbitrary:l rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c1 et n' c2 l)
  thus ?case by simp
next
  case (Proc_CFG_SeqConnect c1 et c2 l)
  thus ?case by simp
next
  case (Proc_CFG_SeqSecond c2 n et n' c1 l) 
  note n = n  #:c1 = Label l 
  note IH = l. n = Label l  l < #:c2
  from n obtain l' where l':"n = Label l'" by(cases n) auto
  from IH[OF this] have "l' < #:c2" .
  with n l' show ?case by simp
next
  case (Proc_CFG_CondThen c1 n et n' b c2 l) 
  note n = n  1 = Label l
  note IH = l. n = Label l  l < #:c1
  from n obtain l' where l':"n = Label l'" by(cases n) auto
  from IH[OF this] have "l' < #:c1" .
  with n l' show ?case by simp
next
  case (Proc_CFG_CondElse c2 n et n' b c1 l)
  note n = n  (#:c1 + 1) = Label l
  note IH = l. n = Label l  l < #:c2
  from n obtain l' where l':"n = Label l'" by(cases n) auto
  from IH[OF this] have "l' < #:c2" .
  with n l' show ?case by simp
next
  case (Proc_CFG_WhileBody c' n et n' b l)
  note n = n  2 = Label l 
  note IH = l. n = Label l  l < #:c'
  from n obtain l' where l':"n = Label l'" by(cases n) auto
  from IH[OF this] have "l' < #:c'" .
  with n l' show ?case by simp
next
  case (Proc_CFG_WhileBodyExit c' n et b l)
  note n = n  2 = Label l 
  note IH = l. n = Label l  l < #:c'
  from n obtain l' where l':"n = Label l'" by(cases n) auto
  from IH[OF this] have "l' < #:c'" .
  with n l' show ?case by simp
qed (auto simp:num_inner_nodes_gr_0)


lemma Proc_CFG_targetlabel_less_num_nodes:
  "prog  n -etp Label l  l < #:prog"
proof(induct prog n et "Label l" arbitrary:l rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c1 n et c2 l)
 thus ?case by simp
next
  case (Proc_CFG_SeqSecond c2 n et n' c1 l)
  note n' = n'  #:c1 = Label l 
  note IH = l. n' = Label l  l < #:c2
  from n' obtain l' where l':"n' = Label l'" by(cases n') auto
  from IH[OF this] have "l' < #:c2" .
  with n' l' show ?case by simp
next
  case (Proc_CFG_CondThen c1 n et n' b c2 l)
  note n' = n'  1 = Label l 
  note IH = l. n' = Label l  l < #:c1
  from n' obtain l' where l':"n' = Label l'" by(cases n') auto
  from IH[OF this] have "l' < #:c1" .
  with n' l' show ?case by simp
next
  case (Proc_CFG_CondElse c2 n et n' b c1 l)
  note n' = n'  (#:c1 + 1) = Label l 
  note IH = l. n' = Label l  l < #:c2
  from n' obtain l' where l':"n' = Label l'" by(cases n') auto
  from IH[OF this] have "l' < #:c2" .
  with n' l' show ?case by simp
next
  case (Proc_CFG_WhileBody c' n et n' b l)
  note n' = n'  2 = Label l 
note IH = l. n' = Label l  l < #:c'
  from n' obtain l' where l':"n' = Label l'" by(cases n') auto
  from IH[OF this] have "l' < #:c'" .
  with n' l' show ?case by simp
qed (auto simp:num_inner_nodes_gr_0)


lemma Proc_CFG_EntryD:
  "prog  Entry -etp n' 
   (n' = Exit  et = IEdge(λs. False))  (n' = Label 0  et = IEdge (λs. True))"
by(induct prog n"Entry" et n' rule:Proc_CFG.induct,auto)


lemma Proc_CFG_Exit_edge:
  obtains l et where "prog  Label l -IEdge etp Exit" and "l  #:prog"
proof(atomize_elim)
  show "l et. prog  Label l -IEdge etp Exit  l  #:prog"
  proof(induct prog)
    case Skip
    have "Skip  Label 0 -IEdge idp Exit" by(rule Proc_CFG_Skip)
    thus ?case by fastforce
  next
    case (LAss V e)
    have "V:=e  Label 1 -IEdge idp Exit" by(rule Proc_CFG_LAssSkip)
    thus ?case by fastforce
  next
    case (Seq c1 c2)
    from l et. c2  Label l -IEdge etp Exit  l  #:c2
    obtain l et where "c2  Label l -IEdge etp Exit" and "l  #:c2" by blast
    hence "c1;;c2  Label l  #:c1 -IEdge etp Exit  #:c1"
      by(fastforce intro:Proc_CFG_SeqSecond)
    with l  #:c2 show ?case by fastforce
  next
    case (Cond b c1 c2)
    from l et. c1  Label l -IEdge etp Exit  l  #:c1
    obtain l et where "c1  Label l -IEdge etp Exit" and "l  #:c1" by blast
    hence "if (b) c1 else c2  Label l  1 -IEdge etp Exit  1"
      by(fastforce intro:Proc_CFG_CondThen)
    with l  #:c1 show ?case by fastforce
  next
    case (While b c')
    have "while (b) c'  Label 1 -IEdge idp Exit" by(rule Proc_CFG_WhileFalseSkip)
    thus ?case by fastforce
  next
    case (Call p es rets)
    have "Call p es rets  Label 1 -IEdge idp Exit" by(rule Proc_CFG_CallSkip)
    thus ?case by fastforce
  qed
qed


text ‹Lots of lemmas for call edges …›

lemma Proc_CFG_Call_Labels:
  "prog  n -CEdge (p,es,rets)p n'  l. n = Label l  n' = Label (Suc l)"
by(induct prog n et"CEdge (p,es,rets)" n' rule:Proc_CFG.induct,auto)


lemma Proc_CFG_Call_target_0:
  "prog  n -CEdge (p,es,rets)p Label 0  n = Entry"
by(induct prog n et"CEdge (p,es,rets)" n'"Label 0" rule:Proc_CFG.induct)
  (auto dest:Proc_CFG_Call_Labels)


lemma Proc_CFG_Call_Intra_edge_not_same_source:
  "prog  n -CEdge (p,es,rets)p n'; prog  n -IEdge etp n''  False"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c1 n n' c2)
  note IH = n''. c1  n -IEdge etp n''  False›
  from c1;;c2  n -IEdge etp n'' c1  n -CEdge (p, es, rets)p n' 
    n'  Exit›
  obtain nx where "c1  n -IEdge etp nx"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG_Entry_Exit Proc_CFG_Entry)
    by(case_tac n)(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_SeqConnect c1 n c2)
  from c1  n -CEdge (p, es, rets)p Exit›
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case (Proc_CFG_SeqSecond c2 n n' c1)
  note IH = n''. c2  n -IEdge etp n''  False›
  from c1;;c2  n  #:c1 -IEdge etp n'' c2  n -CEdge (p, es, rets)p n' 
    n  Entry›
  obtain nx where "c2  n -IEdge etp nx"
    apply - apply(erule Proc_CFG.cases,auto)
      apply(cases n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
     apply(cases n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(cases n,auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondThen c1 n n' b c2)
  note IH = n''. c1  n -IEdge etp n''  False›
  from if (b) c1 else c2  n  1 -IEdge etp n'' c1  n -CEdge (p, es, rets)p n'
    n  Entry›
  obtain nx where "c1  n -IEdge etp nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(cases n) apply auto apply(case_tac n) apply auto
    apply(cases n) apply auto
    by(case_tac n)(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondElse c2 n n' b c1)
  note IH = n''. c2  n -IEdge etp n''  False›
  from if (b) c1 else c2  n  #:c1 + 1 -IEdge etp n'' c2  n -CEdge (p, es, rets)p n'
    n  Entry›
  obtain nx where "c2  n -IEdge etp nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(cases n) apply auto
     apply(case_tac n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(cases n,auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBody c' n n' b)
  note IH = n''. c'  n -IEdge etp n''  False›
  from while (b) c'  n  2 -IEdge etp n'' c'  n -CEdge (p, es, rets)p n'
    n  Entry› n'  Exit›
  obtain nx where "c'  n -IEdge etp nx"
    apply - apply(erule Proc_CFG.cases,auto)
      apply(drule label_incr_ge[OF sym]) apply simp
     apply(cases n) apply auto apply(case_tac n) apply auto
    by(cases n,auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBodyExit c' n b)
  from c'  n -CEdge (p, es, rets)p Exit›
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case Proc_CFG_Call
  from ‹Call p es rets  Label 0 -IEdge etp n''
  show ?case by(fastforce elim:Proc_CFG.cases)
qed


lemma Proc_CFG_Call_Intra_edge_not_same_target:
  "prog  n -CEdge (p,es,rets)p n'; prog  n'' -IEdge etp n'  False"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c1 n n' c2)
  note IH = n''. c1  n'' -IEdge etp n'  False›
  from c1;;c2  n'' -IEdge etp n' c1  n -CEdge (p, es, rets)p n' 
    n'  Exit›
  have "c1  n'' -IEdge etp n'"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG_Entry dest:Proc_CFG_targetlabel_less_num_nodes) 
    by(case_tac n')(auto dest:Proc_CFG_targetlabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_SeqConnect c1 n c2)
  from c1  n -CEdge (p, es, rets)p Exit›
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case (Proc_CFG_SeqSecond c2 n n' c1)
  note IH = n''. c2  n'' -IEdge etp n'  False›
  from c1;;c2  n'' -IEdge etp n'  #:c1 c2  n -CEdge (p, es, rets)p n' 
    n  Entry›
  obtain nx where "c2  nx -IEdge etp n'"
    apply - apply(erule Proc_CFG.cases,auto)
       apply(fastforce intro:Proc_CFG_Entry_Exit)
      apply(cases n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
     apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
    apply(cases n') apply(auto dest:Proc_CFG_Call_Labels)
    by(case_tac n') auto
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondThen c1 n n' b c2)
  note IH = n''. c1  n'' -IEdge etp n'  False›
  from if (b) c1 else c2  n'' -IEdge etp n'  1 c1  n -CEdge (p, es, rets)p n'
    n  Entry›
  obtain nx where "c1  nx -IEdge etp n'"
    apply - apply(erule Proc_CFG.cases,auto)
        apply(cases n') apply(auto intro:Proc_CFG_Entry_Exit)
       apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
      apply(cases n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
     apply(cases n') apply auto apply(case_tac n') apply auto
    apply(cases n') apply auto
    apply(case_tac n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
    by(case_tac n')(auto dest:Proc_CFG_Call_Labels)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondElse c2 n n' b c1)
  note IH = n''. c2  n'' -IEdge etp n'  False›
  from if (b) c1 else c2  n'' -IEdge etp n'  #:c1 + 1 c2  n -CEdge (p, es, rets)p n'
    n  Entry›
  obtain nx where "c2  nx -IEdge etp n'"
    apply - apply(erule Proc_CFG.cases,auto)
        apply(cases n') apply(auto intro:Proc_CFG_Entry_Exit)
       apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
      apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
     apply(cases n') apply auto
      apply(case_tac n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
     apply(case_tac n') apply(auto dest:Proc_CFG_Call_Labels)
    by(cases n',auto,case_tac n',auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBody c' n n' b)
  note IH = n''. c'  n'' -IEdge etp n'  False›
  from while (b) c'  n'' -IEdge etp n'  2 c'  n -CEdge (p, es, rets)p n'
    n  Entry› n'  Exit›
  obtain nx where "c'  nx -IEdge etp n'"
    apply - apply(erule Proc_CFG.cases,auto)
      apply(cases n') apply(auto dest:Proc_CFG_Call_target_0)
     apply(cases n') apply auto
    by(cases n',auto,case_tac n',auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBodyExit c' n b)
  from c'  n -CEdge (p, es, rets)p Exit›
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case Proc_CFG_Call
  from ‹Call p es rets  n'' -IEdge etp Label 1
  show ?case by(fastforce elim:Proc_CFG.cases)
qed


lemma Proc_CFG_Call_nodes_eq:
  "prog  n -CEdge (p,es,rets)p n'; prog  n -CEdge (p',es',rets')p n''
   n' = n''  p = p'  es = es'  rets = rets'"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c1 n n' c2)
  note IH = n''. c1  n -CEdge (p',es',rets')p n''
     n' = n''  p = p'  es = es'  rets = rets'
  from c1;; c2  n -CEdge (p',es',rets')p n'' c1  n -CEdge (p,es,rets)p n'
  have "c1  n -CEdge (p',es',rets')p n''"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(fastforce dest:Proc_CFG_Call_Labels)
    by(case_tac n,(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes)+)
  then show ?case by (rule IH)
next
  case (Proc_CFG_SeqConnect c1 n c2)
  from c1  n -CEdge (p,es,rets)p Exit› have False
    by(fastforce dest:Proc_CFG_Call_Labels)
  thus ?case by simp
next
  case (Proc_CFG_SeqSecond c2 n n' c1)
  note IH = n''. c2  n -CEdge (p',es',rets')p n''
     n' = n''  p = p'  es = es'  rets = rets'
  from c1;;c2  n  #:c1 -CEdge (p',es',rets')p n'' n  Entry›
  obtain nx where edge:"c2  n -CEdge (p',es',rets')p nx" and nx:"nx  #:c1 = n''"
    apply - apply(erule Proc_CFG.cases,auto)
    by(cases n,auto dest:Proc_CFG_sourcelabel_less_num_nodes label_incr_inj)+
  from edge have "n' = nx  p = p'  es = es'  rets = rets'" by (rule IH)
  with nx show ?case by auto
next
  case (Proc_CFG_CondThen c1 n n' b c2)
  note IH = n''. c1  n -CEdge (p',es',rets')p n''
     n' = n''  p = p'  es = es'  rets = rets'
  from if (b) c1 else c2  n  1 -CEdge (p',es',rets')p n''
  obtain nx where "c1  n -CEdge (p',es',rets')p nx  nx  1 = n''"
  proof(rule Proc_CFG.cases)
    fix c2' nx etx nx' bx c1'
    assume "if (b) c1 else c2 = if (bx) c1' else c2'"
      and "n  1 = nx  #:c1' + 1" and "nx  Entry"
    with c1  n -CEdge (p,es,rets)p n' obtain l where "n = Label l" and "l  #:c1"
      by(cases n,auto,cases nx,auto)
    with c1  n -CEdge (p,es,rets)p n' have False
      by(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes)
    thus ?thesis by simp
  qed (auto dest:label_incr_inj)
  then obtain nx where edge:"c1  n -CEdge (p',es',rets')p nx" 
    and nx:"nx  1 = n''" by blast
  from IH[OF edge] nx show ?case by simp
next
  case (Proc_CFG_CondElse c2 n n' b c1)
  note IH = n''. c2  n -CEdge (p',es',rets')p n''
     n' = n''  p = p'  es = es'  rets = rets'
  from if (b) c1 else c2  n  #:c1 + 1 -CEdge (p',es',rets')p n''
  obtain nx where "c2  n -CEdge (p',es',rets')p nx  nx  #:c1 + 1 = n''"
  proof(rule Proc_CFG.cases)
    fix c1' nx etx nx' bx c2'
    assume ifs:"if (b) c1 else c2 = if (bx) c1' else c2'"
      and "n  #:c1 + 1 = nx  1" and "nx  Entry"
      and edge:"c1'  nx -etxp nx'"
    then obtain l where "nx = Label l" and "l  #:c1"
      by(cases n,auto,cases nx,auto)
    with edge ifs have False
      by(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes)
    thus ?thesis by simp
  qed (auto dest:label_incr_inj)
  then obtain nx where edge:"c2  n -CEdge (p',es',rets')p nx"
    and nx:"nx  #:c1 + 1 = n''"
    by blast
  from IH[OF edge] nx show ?case by simp
next
  case (Proc_CFG_WhileBody c' n n' b)
  note IH = n''. c'  n -CEdge (p',es',rets')p n''
     n' = n''  p = p'  es = es'  rets = rets'
  from while (b) c'  n  2 -CEdge (p',es',rets')p n''
  obtain nx where "c'  n -CEdge (p',es',rets')p nx  nx  2 = n''"
    by(rule Proc_CFG.cases,auto dest:label_incr_inj Proc_CFG_Call_Labels)
  then obtain nx where edge:"c'  n -CEdge (p',es',rets')p nx" 
    and nx:"nx  2 = n''" by blast
  from IH[OF edge] nx show ?case by simp
next
  case (Proc_CFG_WhileBodyExit c' n b)
  from c'  n -CEdge (p,es,rets)p Exit› have False
    by(fastforce dest:Proc_CFG_Call_Labels)
  thus ?case by simp
next
  case Proc_CFG_Call
  from ‹Call p es rets  Label 0 -CEdge (p',es',rets')p n''
  have "p = p'  es = es'  rets = rets'  n'' = Label 1"
    by(auto elim:Proc_CFG.cases)
  then show ?case by simp
qed


lemma Proc_CFG_Call_nodes_eq':
  "prog  n -CEdge (p,es,rets)p n'; prog  n'' -CEdge (p',es',rets')p n'
   n = n''  p = p'  es = es'  rets = rets'"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c1 n n' c2)
  note IH = n''. c1  n'' -CEdge (p',es',rets')p n'
     n = n''  p = p'  es = es'  rets = rets'
  from c1;;c2  n'' -CEdge (p',es',rets')p n' c1  n -CEdge (p,es,rets)p n'
  have "c1  n'' -CEdge (p',es',rets')p n'"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(fastforce dest:Proc_CFG_Call_Labels)
    by(case_tac n',auto dest:Proc_CFG_targetlabel_less_num_nodes Proc_CFG_Call_Labels)
  then show ?case by (rule IH)
next
  case (Proc_CFG_SeqConnect c1 n c2)
  from c1  n -CEdge (p,es,rets)p Exit› have False
    by(fastforce dest:Proc_CFG_Call_Labels)
  thus ?case by simp
next
  case (Proc_CFG_SeqSecond c2 n n' c1)
  note IH = n''. c2  n'' -CEdge (p',es',rets')p n'
     n = n''  p = p'  es = es'  rets = rets'
  from c1;;c2  n'' -CEdge (p',es',rets')p n'  #:c1
  obtain nx where edge:"c2  nx -CEdge (p',es',rets')p n'" and nx:"nx  #:c1 = n''"
    apply - apply(erule Proc_CFG.cases,auto)
    by(cases n',
       auto dest:Proc_CFG_targetlabel_less_num_nodes Proc_CFG_Call_Labels 
                 label_incr_inj)
  from edge have "n = nx  p = p'  es = es'  rets = rets'" by (rule IH)
  with nx show ?case by auto
next
  case (Proc_CFG_CondThen c1 n n' b c2)
  note IH = n''. c1  n'' -CEdge (p',es',rets')p n'
     n = n''  p = p'  es = es'  rets = rets'
  from if (b) c1 else c2  n'' -CEdge (p',es',rets')p n'  1
  obtain nx where "c1  nx -CEdge (p',es',rets')p n'  nx  1 = n''"
  proof(cases)
    case (Proc_CFG_CondElse nx nx')
    from n'  1 = nx'  #:c1 + 1
      c1  n -CEdge (p,es,rets)p n'
    obtain l where "n' = Label l" and "l  #:c1"
      by(cases n', auto dest:Proc_CFG_Call_Labels,cases nx',auto)
    with c1  n -CEdge (p,es,rets)p n' have False
      by(fastforce dest:Proc_CFG_targetlabel_less_num_nodes)
    thus ?thesis by simp
  qed (auto dest:label_incr_inj)
  then obtain nx where edge:"c1  nx -CEdge (p',es',rets')p n'" 
    and nx:"nx  1 = n''"
    by blast
  from IH[OF edge] nx show ?case by simp
next
  case (Proc_CFG_CondElse c2 n n' b c1)
  note IH = n''. c2  n'' -CEdge (p',es',rets')p n'
     n = n''  p = p'  es = es'  rets = rets'
  from if (b) c1 else c2  n'' -CEdge (p',es',rets')p n'  #:c1 + 1
  obtain nx where "c2  nx -CEdge (p',es',rets')p n'  nx  #:c1 + 1 = n''"
  proof(cases)
    case (Proc_CFG_CondThen nx nx')
    from n'  #:c1 + 1 = nx'  1
      c1  nx -CEdge (p',es',rets')p nx'
    obtain l where "nx' = Label l" and "l  #:c1"
      by(cases n',auto,cases nx',auto dest:Proc_CFG_Call_Labels)
    with c1  nx -CEdge (p',es',rets')p nx'
    have False by(fastforce dest:Proc_CFG_targetlabel_less_num_nodes)
    thus ?thesis by simp
  qed (auto dest:label_incr_inj)
  then obtain nx where edge:"c2  nx -CEdge (p',es',rets')p n'" 
    and nx:"nx  #:c1 + 1 = n''"
    by blast
  from IH[OF edge] nx show ?case by simp
next
  case (Proc_CFG_WhileBody c' n n' b)
  note IH = n''. c'  n'' -CEdge (p',es',rets')p n'
     n = n''  p = p'  es = es'  rets = rets'
  from while (b) c'  n'' -CEdge (p',es',rets')p n'  2
  obtain nx where edge:"c'  nx -CEdge (p',es',rets')p n'" and nx:"nx  2 = n''"
    by(rule Proc_CFG.cases,auto dest:label_incr_inj)
  from IH[OF edge] nx show ?case by simp
next
  case (Proc_CFG_WhileBodyExit c' n b)
  from c'  n -CEdge (p,es,rets)p Exit›
  have False by(fastforce dest:Proc_CFG_Call_Labels)
  thus ?case by simp
next
  case Proc_CFG_Call
  from ‹Call p es rets  n'' -CEdge (p',es',rets')p Label 1
  have "p = p'  es = es'  rets = rets'  n'' = Label 0"
    by(auto elim:Proc_CFG.cases)
  then show ?case by simp
qed


lemma Proc_CFG_Call_targetnode_no_Call_sourcenode:
  "prog  n -CEdge (p,es,rets)p n'; prog  n' -CEdge (p',es',rets')p n'' 
   False"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c1 n n' c2)
  note IH = n''. c1  n' -CEdge (p', es', rets')p n''  False›
  from c1;; c2  n' -CEdge (p',es',rets')p n'' c1  n -CEdge (p,es,rets)p n'
  have "c1  n' -CEdge (p',es',rets')p n''"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(fastforce dest:Proc_CFG_Call_Labels)
    by(case_tac n)(auto dest:Proc_CFG_targetlabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_SeqConnect c1 n c2)
  from c1  n -CEdge (p,es,rets)p Exit› have False
    by(fastforce dest:Proc_CFG_Call_Labels)
  thus ?case by simp
next
  case (Proc_CFG_SeqSecond c2 n n' c1)
  note IH = n''. c2  n' -CEdge (p', es', rets')p n''  False›
  from c1;; c2  n'  #:c1 -CEdge (p', es', rets')p n'' c2  n -CEdge (p,es,rets)p n'
  obtain nx where "c2  n' -CEdge (p',es',rets')p nx"
    apply - apply(erule Proc_CFG.cases,auto)
      apply(cases n') apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
     apply(fastforce dest:Proc_CFG_Call_Labels)
    by(cases n',auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondThen c1 n n' b c2)
  note IH = n''. c1  n' -CEdge (p',es',rets')p n''  False›
  from if (b) c1 else c2  n'  1 -CEdge (p', es', rets')p n'' c1  n -CEdge (p,es,rets)p n'
  obtain nx where "c1  n' -CEdge (p',es',rets')p nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(cases n') apply auto apply(case_tac n) apply auto
    apply(cases n') apply auto
    by(case_tac n)(auto dest:Proc_CFG_targetlabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondElse c2 n n' b c1)
  note IH = n''. c2  n' -CEdge (p',es',rets')p n''  False›
  from if (b) c1 else c2  n'  #:c1 + 1 -CEdge (p', es', rets')p n'' 
    c2  n -CEdge (p,es,rets)p n'
  obtain nx where "c2  n' -CEdge (p',es',rets')p nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(cases n') apply auto
     apply(case_tac n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(cases n',auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBody c' n n' b)
  note IH = n''. c'  n' -CEdge (p',es',rets')p n''  False›
  from while (b) c'  n'  2 -CEdge (p', es', rets')p n'' c'  n -CEdge (p,es,rets)p n'
  obtain nx where "c'  n' -CEdge (p',es',rets')p nx"
    apply - apply(erule Proc_CFG.cases,auto)
    by(cases n',auto,case_tac n,auto)+
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBodyExit c' n b)
  from c'  n -CEdge (p, es, rets)p Exit› 
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case Proc_CFG_Call
  from ‹Call p es rets  Label 1 -CEdge (p', es', rets')p n''
  show ?case by(fastforce elim:Proc_CFG.cases)
qed


lemma Proc_CFG_Call_follows_id_edge:
  "prog  n -CEdge (p,es,rets)p n'; prog  n' -IEdge etp n''  et = id"
proof(induct prog n "CEdge (p,es,rets)" n' arbitrary:n'' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqFirst c1 n n' c2)
  note IH = n''. c1  n' -IEdge etp n''  et = id›
  from c1;;c2  n' -IEdge etp n'' c1  n -CEdge (p,es,rets)p n' n'  Exit›
  obtain nx where "c1  n' -IEdge etp nx"
    apply - apply(erule Proc_CFG.cases,auto)
    by(case_tac n)(auto dest:Proc_CFG_targetlabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_SeqConnect c1 n c2)
  from c1  n -CEdge (p, es, rets)p Exit›
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case (Proc_CFG_SeqSecond c2 n n' c1)
  note IH = n''. c2  n' -IEdge etp n''  et = id›
  from c1;;c2  n'  #:c1 -IEdge etp n'' c2  n -CEdge (p,es,rets)p n'
  obtain nx where "c2  n' -IEdge etp nx"
    apply - apply(erule Proc_CFG.cases,auto)
      apply(cases n') apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
     apply(cases n') apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(cases n',auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondThen c1 n n' b c2)
  note IH = n''. c1  n' -IEdge etp n''  et = id›
  from if (b) c1 else c2  n'  1 -IEdge etp n'' c1  n -CEdge (p,es,rets)p n'
    n  Entry›
  obtain nx where "c1  n' -IEdge etp nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(cases n') apply auto apply(case_tac n) apply auto
    apply(cases n') apply auto
    by(case_tac n)(auto dest:Proc_CFG_targetlabel_less_num_nodes)
  then show ?case by (rule IH)
next
  case (Proc_CFG_CondElse c2 n n' b c1)
  note IH = n''. c2  n' -IEdge etp n''  et = id›
  from if (b) c1 else c2  n'  #:c1 + 1 -IEdge etp n'' c2  n -CEdge (p,es,rets)p n'
  obtain nx where "c2  n' -IEdge etp nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(cases n') apply auto
     apply(case_tac n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(cases n',auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBody c' n n' b)
  note IH = n''. c'  n' -IEdge etp n''  et = id›
  from while (b) c'  n'  2 -IEdge etp n'' c'  n -CEdge (p,es,rets)p n'
  obtain nx where "c'  n' -IEdge etp nx"
    apply - apply(erule Proc_CFG.cases,auto)
      apply(cases n') apply auto
     apply(cases n') apply auto apply(case_tac n) apply auto
    by(cases n',auto,case_tac n,auto)
  then show ?case by (rule IH)
next
  case (Proc_CFG_WhileBodyExit c' n et' b)
  from c'  n -CEdge (p, es, rets)p Exit› 
  show ?case by(fastforce dest:Proc_CFG_Call_Labels)
next
  case Proc_CFG_Call
  from ‹Call p es rets  Label 1 -IEdge etp n'' show ?case
    by(fastforce elim:Proc_CFG.cases)
qed


lemma Proc_CFG_edge_det:
  "prog  n -etp n'; prog  n -et'p n'  et = et'"
proof(induct rule:Proc_CFG.induct)
  case Proc_CFG_Entry_Exit thus ?case by(fastforce dest:Proc_CFG_EntryD)
next
  case Proc_CFG_Entry thus ?case by(fastforce dest:Proc_CFG_EntryD)
next
  case Proc_CFG_Skip thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case Proc_CFG_LAss thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case Proc_CFG_LAssSkip thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case (Proc_CFG_SeqFirst c1 n et n' c2)
  note edge = c1  n -etp n' 
  note IH = c1  n -et'p n'  et = et'
  from edge n'  Exit› obtain l where l:"n' = Label l" by (cases n') auto
  with edge have "l < #:c1" by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
  with c1;;c2  n -et'p n' l have "c1  n -et'p n'"
    by(fastforce elim:Proc_CFG.cases intro:Proc_CFG.intros dest:label_incr_ge)
  from IH[OF this] show ?case .
next
  case (Proc_CFG_SeqConnect c1 n et c2)
  note edge = c1  n -etp Exit›
  note IH = c1  n -et'p Exit  et = et'
  from edge n  Entry› obtain l where l:"n = Label l" by (cases n) auto
  with edge have "l < #:c1" by(fastforce intro: Proc_CFG_sourcelabel_less_num_nodes)
  with c1;;c2  n -et'p Label #:c1 l have "c1  n -et'p Exit"
    by(fastforce elim:Proc_CFG.cases 
                dest:Proc_CFG_targetlabel_less_num_nodes label_incr_ge)
  from IH[OF this] show ?case .
next
  case (Proc_CFG_SeqSecond c2 n et n' c1)
  note edge = c2  n -etp n' 
  note IH = c2  n -et'p n'  et = et'
  from edge n  Entry› obtain l where l:"n = Label l" by (cases n) auto
  with edge have "l < #:c2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  with c1;;c2  n  #:c1 -et'p n'  #:c1 l have "c2  n -et'p n'"
    by -(erule Proc_CFG.cases,
    (fastforce dest:Proc_CFG_sourcelabel_less_num_nodes label_incr_ge
              dest!:label_incr_inj)+)
  from IH[OF this] show ?case .
next
  case Proc_CFG_CondTrue thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case Proc_CFG_CondFalse thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case (Proc_CFG_CondThen c1 n et n' b c2)
  note edge = c1  n -etp n'
  note IH = c1  n -et'p n'  et = et'
  from edge n  Entry› obtain l where l:"n = Label l" by (cases n) auto
  with edge have "l < #:c1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  with if (b) c1 else c2  n  1 -et'p n'  1 l have "c1  n -et'p n'"
    by -(erule Proc_CFG.cases,(fastforce dest:label_incr_ge label_incr_inj)+)
  from IH[OF this] show ?case .
next
  case (Proc_CFG_CondElse c2 n et n' b c1)
  note edge = c2  n -etp n'
  note IH = c2  n -et'p n'  et = et'
  from edge n  Entry› obtain l where l:"n = Label l" by (cases n) auto
  with edge have "l < #:c2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  with if (b) c1 else c2  n  (#:c1 + 1) -et'p n'  (#:c1 + 1) l 
  have "c2  n -et'p n'"
    by -(erule Proc_CFG.cases,(fastforce dest:Proc_CFG_sourcelabel_less_num_nodes 
                             label_incr_inj label_incr_ge label_incr_simp_rev)+)
  from IH[OF this] show ?case .
next
  case Proc_CFG_WhileTrue thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case Proc_CFG_WhileFalse thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case Proc_CFG_WhileFalseSkip thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case (Proc_CFG_WhileBody c' n et n' b)
  note edge = c'  n -etp n'
  note IH = c'  n -et'p n'  et = et'
  from edge n  Entry› obtain l where l:"n = Label l" by (cases n) auto
  with edge have less:"l < #:c'" 
    by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  from edge n'  Exit› obtain l' where l':"n' = Label l'" by (cases n') auto
  with edge have "l' < #:c'" by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
  with while (b) c'  n  2 -et'p n'  2 l less l' have "c'  n -et'p n'"
    by(fastforce elim:Proc_CFG.cases dest:label_incr_start_Node_smaller)
  from IH[OF this] show ?case .
next
  case (Proc_CFG_WhileBodyExit c' n et b)
  note edge = c'  n -etp Exit›
  note IH = c'  n -et'p Exit  et = et'
  from edge n  Entry› obtain l where l:"n = Label l" by (cases n) auto
  with edge have "l < #:c'" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  with while (b) c'  n  2 -et'p Label 0 l have "c'  n -et'p Exit"
    by -(erule Proc_CFG.cases,auto dest:label_incr_start_Node_smaller)
  from IH[OF this] show ?case .
next
  case Proc_CFG_Call thus ?case by(fastforce elim:Proc_CFG.cases)
next
  case Proc_CFG_CallSkip thus ?case by(fastforce elim:Proc_CFG.cases)
qed


lemma WCFG_deterministic:
  "prog  n1 -et1p n1'; prog  n2 -et2p n2'; n1 = n2; n1'  n2'
   Q Q'. et1 = IEdge (Q)  et2 = IEdge (Q')  
            (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))"
proof(induct arbitrary:n2 n2' rule:Proc_CFG.induct)
  case (Proc_CFG_Entry_Exit prog)
  from prog  n2 -et2p n2' ‹Entry = n2 ‹Exit  n2'
  have "et2 = IEdge (λs. True)" by(fastforce dest:Proc_CFG_EntryD)
  thus ?case by simp
next
  case (Proc_CFG_Entry prog)
  from prog  n2 -et2p n2' ‹Entry = n2 ‹Label 0  n2'
  have "et2 = IEdge (λs. False)" by(fastforce dest:Proc_CFG_EntryD)
  thus ?case by simp
next
  case Proc_CFG_Skip
  from ‹Skip  n2 -et2p n2' ‹Label 0 = n2 ‹Exit  n2'
  have False by(fastforce elim:Proc_CFG.cases)
  thus ?case by simp
next
  case (Proc_CFG_LAss V e)
  from V:=e  n2 -et2p n2' ‹Label 0 = n2 ‹Label 1  n2'
  have False by -(erule Proc_CFG.cases,auto)
  thus ?case by simp
next
  case (Proc_CFG_LAssSkip V e)
  from V:=e  n2 -et2p n2' ‹Label 1 = n2 ‹Exit  n2'
  have False by -(erule Proc_CFG.cases,auto)
  thus ?case by simp
next
  case (Proc_CFG_SeqFirst c1 n et n' c2)
  note IH = n2 n2'. c1  n2 -et2p n2'; n = n2; n'  n2'
   Q Q'. et = IEdge (Q)  et2 = IEdge (Q')  
            (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from c1;;c2  n2 -et2p n2' c1  n -etp n' n = n2 n'  n2'
  have "c1  n2 -et2p n2'  (c1  n2 -et2p Exit  n2' = Label #:c1)"
    apply hypsubst_thin apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros)
    by(case_tac n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)+
  thus ?case
  proof
    assume "c1  n2 -et2p n2'"
    from IH[OF this n = n2 n'  n2'] show ?case .
  next
    assume "c1  n2 -et2p Exit  n2' = Label #:c1"
    hence edge:"c1  n2 -et2p Exit" and n2':"n2' = Label #:c1" by simp_all
    from IH[OF edge n = n2 n'  Exit›] show ?case .
  qed
next
  case (Proc_CFG_SeqConnect c1 n et c2)
  note IH = n2 n2'. c1  n2 -et2p n2'; n = n2; Exit  n2'
   Q Q'. et = IEdge (Q)  et2 = IEdge (Q')  
            (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from c1;;c2  n2 -et2p n2' c1  n -etp Exit› n = n2 n  Entry›
    ‹Label #:c1  n2' have "c1  n2 -et2p n2'  Exit  n2'"
    apply hypsubst_thin apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros)
    by(case_tac n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)+
  from IH[OF this[THEN conjunct1] n = n2 this[THEN conjunct2]]
  show ?case .
next
  case (Proc_CFG_SeqSecond c2 n et n' c1)
  note IH = n2 n2'. c2  n2 -et2p n2'; n = n2; n'  n2'
   Q Q'. et = IEdge (Q)  et2 = IEdge (Q')  
            (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from c1;;c2  n2 -et2p n2' c2  n -etp n' n  #:c1 = n2
    n'  #:c1  n2' n  Entry›
  obtain nx where "c2  n -et2p nx  nx  #:c1 = n2'"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros)
      apply(cases n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)
     apply(cases n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(fastforce dest:label_incr_inj)
  with n'  #:c1  n2' have edge:"c2  n -et2p nx" and neq:"n'  nx"
    by auto
  from IH[OF edge _ neq] show ?case by simp
next
  case (Proc_CFG_CondTrue b c1 c2)
  from if (b) c1 else c2  n2 -et2p n2' ‹Label 0 = n2 ‹Label 1  n2'
  show ?case by -(erule Proc_CFG.cases,auto)
next
  case (Proc_CFG_CondFalse b c1 c2)
  from if (b) c1 else c2  n2 -et2p n2' ‹Label 0 = n2 ‹Label (#:c1 + 1)  n2'
  show ?case by -(erule Proc_CFG.cases,auto)
next
  case (Proc_CFG_CondThen c1 n et n' b c2)
  note IH = n2 n2'. c1  n2 -et2p n2'; n = n2; n'  n2'
     Q Q'. et = IEdge (Q)  et2 = IEdge (Q')  
              (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from if (b) c1 else c2  n2 -et2p n2' c1  n -etp n' n  Entry› 
    n  1 = n2 n'  1  n2'
  obtain nx where "c1  n -et2p nx  n'  nx"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros simp del:One_nat_def)
     apply(drule label_incr_inj) apply(auto simp del:One_nat_def)
    apply(drule label_incr_simp_rev[OF sym])
    by(case_tac na,auto dest:Proc_CFG_sourcelabel_less_num_nodes)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case (Proc_CFG_CondElse c2 n et n' b c1)
  note IH = n2 n2'. c2  n2 -et2p n2'; n = n2; n'  n2'
     Q Q'. et = IEdge (Q)  et2 = IEdge (Q')  
              (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from if (b) c1 else c2  n2 -et2p n2' c2  n -etp n' n  Entry› 
    n  #:c1 + 1 = n2 n'  #:c1 + 1  n2'
  obtain nx where "c2  n -et2p nx  n'  nx"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros simp del:One_nat_def)
     apply(drule label_incr_simp_rev)
     apply(case_tac na,auto,cases n,auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(fastforce dest:label_incr_inj)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case (Proc_CFG_WhileTrue b c')
  from while (b) c'  n2 -et2p n2' ‹Label 0 = n2 ‹Label 2  n2'
  show ?case by -(erule Proc_CFG.cases,auto)
next
  case (Proc_CFG_WhileFalse b c')
  from while (b) c'  n2 -et2p n2' ‹Label 0 = n2 ‹Label 1  n2'
  show ?case by -(erule Proc_CFG.cases,auto)
next
  case (Proc_CFG_WhileFalseSkip b c')
  from while (b) c'  n2 -et2p n2' ‹Label 1 = n2 ‹Exit  n2'
  show ?case by -(erule Proc_CFG.cases,auto dest:label_incr_ge)
next
  case (Proc_CFG_WhileBody c' n et n' b)
  note IH = n2 n2'. c'  n2 -et2p n2'; n = n2; n'  n2'
     Q Q'. et = IEdge (Q)  et2 = IEdge (Q')  
              (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from while (b) c'  n2 -et2p n2' c'  n -etp n' n  Entry›
    n'  Exit› n  2 = n2 n'  2  n2'
  obtain nx where "c'  n -et2p nx  n'  nx"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros)
      apply(fastforce dest:label_incr_ge[OF sym])
     apply(fastforce dest:label_incr_inj)
    by(fastforce dest:label_incr_inj)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case (Proc_CFG_WhileBodyExit c' n et b)
  note IH = n2 n2'. c'  n2 -et2p n2'; n = n2; Exit  n2'
     Q Q'. et = IEdge (Q)  et2 = IEdge (Q')  
              (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))
  from while (b) c'  n2 -et2p n2' c'  n -etp Exit› n  Entry›
    n  2 = n2 ‹Label 0  n2'
  obtain nx where "c'  n -et2p nx  Exit  nx"
    apply - apply(erule Proc_CFG.cases)
    apply(auto intro:Proc_CFG.intros)
     apply(fastforce dest:label_incr_ge[OF sym])
    by(fastforce dest:label_incr_inj)
  from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
  case Proc_CFG_Call thus ?case by -(erule Proc_CFG.cases,auto)
next
  case Proc_CFG_CallSkip thus ?case by -(erule Proc_CFG.cases,auto)
qed


subsection ‹And now: the interprocedural CFG›

subsubsection ‹Statements containing calls›

text ‹A procedure is a tuple composed of its name, its input and output variables
  and its method body›

type_synonym proc = "(pname × vname list × vname list × cmd)"
type_synonym procs = "proc list"


text containsCall› guarantees that a call to procedure p is in
  a certain statement.›

declare conj_cong[fundef_cong]

function containsCall :: 
  "procs  cmd  pname list  pname  bool"
where "containsCall procs Skip ps p  False"
  | "containsCall procs (V:=e) ps p  False"
  | "containsCall procs (c1;;c2) ps p  
       containsCall procs c1 ps p  containsCall procs c2 ps p"
  | "containsCall procs (if (b) c1 else c2) ps p  
       containsCall procs c1 ps p  containsCall procs c2 ps p"
  | "containsCall procs (while (b) c) ps p  
       containsCall procs c ps p"
  | "containsCall procs (Call q es' rets') ps p  p = q  ps = []  
       (ins outs c ps'. ps = q#ps'  (q,ins,outs,c)  set procs 
                     containsCall procs c ps' p)"
by pat_completeness auto
termination containsCall
by(relation "measures [λ(procs,c,ps,p). length ps, 
  λ(procs,c,ps,p). size c]") auto


lemmas containsCall_induct[case_names Skip LAss Seq Cond While Call] = 
  containsCall.induct


lemma containsCallcases: 
  "containsCall procs prog ps p
   ps = []  containsCall procs prog ps p  
  (q ins outs c ps'. ps = ps'@[q]  (q,ins,outs,c)  set procs 
  containsCall procs c [] p  containsCall procs prog ps' q)"
proof(induct procs prog ps p rule:containsCall_induct)
  case (Call procs q es' rets' ps p)
  note IH = x y z ps'. ps = q#ps'; (q,x,y,z)  set procs;
    containsCall procs z ps' p
     ps' = []  containsCall procs z ps' p  
    (qx ins outs c psx. ps' = psx@[qx]  (qx,ins,outs,c)  set procs 
    containsCall procs c [] p  
    containsCall procs z psx qx)
  from ‹containsCall procs (Call q es' rets') ps p
  have "p = q  ps = []  
    (ins outs c ps'. ps = q#ps'  (q,ins,outs,c)  set procs 
                  containsCall procs c ps' p)" by simp
  thus ?case
  proof
    assume assms:"p = q  ps = []"
    hence "containsCall procs (Call q es' rets') ps p" by simp
    with assms show ?thesis by simp
  next
    assume "ins outs c ps'. ps = q#ps'  (q,ins,outs,c)  set procs 
      containsCall procs c ps' p"
    then obtain ins outs c ps' where "ps = q#ps'" and "(q,ins,outs,c)  set procs"
      and "containsCall procs c ps' p" by blast
    from IH[OF this] have "ps' = []  containsCall procs c ps' p 
      (qx insx outsx cx psx. 
         ps' = psx @ [qx]  (qx,insx,outsx,cx)  set procs 
         containsCall procs cx [] p  containsCall procs c psx qx)" .
    thus ?thesis
    proof
      assume assms:"ps' = []  containsCall procs c ps' p"
      have "containsCall procs (Call q es' rets') [] q" by simp
      with assms ps = q#ps' (q,ins,outs,c)  set procs show ?thesis by fastforce
    next
      assume "qx insx outsx cx psx. 
        ps' = psx@[qx]  (qx,insx,outsx,cx)  set procs 
        containsCall procs cx [] p  containsCall procs c psx qx"
      then obtain qx insx outsx cx psx
        where "ps' = psx@[qx]" and "(qx,insx,outsx,cx)  set procs"
        and "containsCall procs cx [] p"
        and "containsCall procs c psx qx" by blast
      from (q,ins,outs,c)  set procs ‹containsCall procs c psx qx
      have "containsCall procs (Call q es' rets') (q#psx) qx" by fastforce
      with ps' = psx@[qx] ps = q#ps' (qx,insx,outsx,cx)  set procs
        ‹containsCall procs cx [] p show ?thesis by fastforce
    qed
  qed
qed auto



lemma containsCallE:
  "containsCall procs prog ps p; 
    ps = []; containsCall procs prog ps p  P procs prog ps p;
    q ins outs c es' rets' ps'. ps = ps'@[q]; (q,ins,outs,c)  set procs; 
      containsCall procs c [] p; containsCall procs prog ps' q 
      P procs prog ps p  P procs prog ps p"
  by(auto dest:containsCallcases)


lemma containsCall_in_proc: 
  "containsCall procs prog qs q; (q,ins,outs,c)  set procs; 
  containsCall procs c [] p
   containsCall procs prog (qs@[q]) p"
proof(induct procs prog qs q rule:containsCall_induct)
  case (Call procs qx esx retsx ps p')
  note IH = x y z psx. ps = qx#psx; (qx,x,y,z)  set procs;
    containsCall procs z psx p'; (p',ins,outs,c)  set procs; 
    containsCall procs c [] p  containsCall procs z (psx@[p']) p
  from ‹containsCall procs (Call qx esx retsx) ps p'
  have "p' = qx  ps = [] 
    (insx outsx cx psx. ps = qx#psx  (qx,insx,outsx,cx)  set procs 
    containsCall procs cx psx p')" by simp
  thus ?case
  proof
    assume assms:"p' = qx  ps = []"
    with (p', ins, outs, c)  set procs ‹containsCall procs c [] p
    have "containsCall procs (Call qx esx retsx) [p'] p" by fastforce
    with assms show ?thesis by simp
  next
    assume "insx outsx cx psx. ps = qx#psx  (qx,insx,outsx,cx)  set procs 
      containsCall procs cx psx p'"
    then obtain insx outsx cx psx where "ps = qx#psx" 
      and "(qx,insx,outsx,cx)  set procs"
      and "containsCall procs cx psx p'" by blast
    from IH[OF this (p', ins, outs, c)  set procs 
      ‹containsCall procs c [] p] 
    have "containsCall procs cx (psx @ [p']) p" .
    with ps = qx#psx (qx,insx,outsx,cx)  set procs
    show ?thesis by fastforce
  qed
qed auto
    

lemma containsCall_indirection:
  "containsCall procs prog qs q; containsCall procs c ps p;
  (q,ins,outs,c)  set procs
   containsCall procs prog (qs@q#ps) p"
proof(induct procs prog qs q rule:containsCall_induct)
  case (Call procs px esx retsx ps' p')
  note IH = x y z psx. ps' = px # psx; (px, x, y, z)  set procs;
    containsCall procs z psx p'; containsCall procs c ps p;
    (p', ins, outs, c)  set procs
     containsCall procs z (psx @ p' # ps) p
  from ‹containsCall procs (Call px esx retsx) ps' p'
  have "p' = px  ps' = [] 
    (insx outsx cx psx. ps' = px#psx  (px,insx,outsx,cx)  set procs 
    containsCall procs cx psx p')" by simp
  thus ?case
  proof
    assume "p' = px  ps' = []"
    with ‹containsCall procs c ps p (p', ins, outs, c)  set procs
    show ?thesis by fastforce
  next
    assume "insx outsx cx psx. ps' = px#psx  (px,insx,outsx,cx)  set procs 
      containsCall procs cx psx p'"
    then obtain insx outsx cx psx where "ps' = px#psx" 
      and "(px,insx,outsx,cx)  set procs"
      and "containsCall procs cx psx p'" by blast
    from IH[OF this ‹containsCall procs c ps p
      (p', ins, outs, c)  set procs] 
    have "containsCall procs cx (psx @ p' # ps) p" .
    with ps' = px#psx (px,insx,outsx,cx)  set procs
    show ?thesis by fastforce
  qed
qed auto


lemma Proc_CFG_Call_containsCall:
  "prog  n -CEdge (p,es,rets)p n'  containsCall procs prog [] p"
by(induct prog n et"CEdge (p,es,rets)" n' rule:Proc_CFG.induct,auto)


lemma containsCall_empty_Proc_CFG_Call_edge: 
  assumes "containsCall procs prog [] p"
  obtains l es rets l' where "prog  Label l -CEdge (p,es,rets)p Label l'"
proof(atomize_elim)
  from ‹containsCall procs prog [] p
  show "l es rets l'. prog  Label l -CEdge (p,es,rets)p Label l'"
  proof(induct procs prog ps"[]::pname list" p rule:containsCall_induct)
    case Seq thus ?case
      by auto(fastforce dest:Proc_CFG_SeqFirst,fastforce dest:Proc_CFG_SeqSecond)
  next
    case Cond thus ?case
      by auto(fastforce dest:Proc_CFG_CondThen,fastforce dest:Proc_CFG_CondElse)
  next
    case While thus ?case by(fastforce dest:Proc_CFG_WhileBody)
  next
    case Call thus ?case by(fastforce intro:Proc_CFG_Call)
  qed auto
qed


subsubsection‹The edges of the combined CFG›

type_synonym node = "(pname × label)"
type_synonym edge = "(node × (vname,val,node,pname) edge_kind × node)"

fun get_proc :: "node  pname"
  where "get_proc (p,l) = p"


inductive PCFG :: 
  "cmd  procs  node  (vname,val,node,pname) edge_kind  node  bool" 
("_,_  _ -_ _" [51,51,0,0,0] 81)
for prog::cmd and procs::procs
where

  Main:
  "prog  n -IEdge etp n'  prog,procs  (Main,n) -et (Main,n')"

| Proc:
  "(p,ins,outs,c)  set procs; c  n -IEdge etp n'; 
    containsCall procs prog ps p 
   prog,procs  (p,n) -et (p,n')"


| MainCall:
  "prog  Label l -CEdge (p,es,rets)p n'; (p,ins,outs,c)  set procs
   prog,procs  (Main,Label l) 
                  -(λs. True):(Main,n')pmap (λe cf. interpret e cf) es (p,Entry)"

| ProcCall:
  "(p,ins,outs,c)  set procs; c  Label l -CEdge (p',es',rets')p Label l';
    (p',ins',outs',c')  set procs; containsCall procs prog ps p
   prog,procs  (p,Label l) 
               -(λs. True):(p,Label l')p'map (λe cf. interpret e cf) es' (p',Entry)"

| MainReturn:
  "prog  Label l -CEdge (p,es,rets)p Label l'; (p,ins,outs,c)  set procs
   prog,procs  (p,Exit) -(λcf. snd cf = (Main,Label l'))p
       (λcf cf'. cf'(rets [:=] map cf outs)) (Main,Label l')"

| ProcReturn:
  "(p,ins,outs,c)  set procs; c  Label l -CEdge (p',es',rets')p Label l'; 
   (p',ins',outs',c')  set procs; containsCall procs prog ps p
   prog,procs  (p',Exit) -(λcf. snd cf = (p,Label l'))p'
       (λcf cf'. cf'(rets' [:=] map cf outs')) (p,Label l')"

| MainCallReturn:
  "prog  n -CEdge (p,es,rets)p n'
   prog,procs  (Main,n) -(λs. False) (Main,n')"

| ProcCallReturn:
  "(p,ins,outs,c)  set procs; c  n -CEdge (p',es',rets')p n'; 
    containsCall procs prog ps p 
   prog,procs  (p,n) -(λs. False) (p,n')"


end

Theory WellFormProgs

section ‹Well-formedness of programs›

theory WellFormProgs imports PCFG begin

subsection ‹Well-formedness of procedure lists.›

definition wf_proc :: "proc  bool"
  where "wf_proc x  let (p,ins,outs,c) = x in 
  p  Main  distinct ins  distinct outs"

definition well_formed :: "procs  bool"
  where "well_formed procs  distinct_fst procs  
  ((p,ins,outs,c)  set procs. wf_proc (p,ins,outs,c))"

lemma [dest]:"well_formed procs; (Main,ins,outs,c)  set procs  False"
  by(fastforce simp:well_formed_def wf_proc_def)

lemma well_formed_same_procs [dest]:
  "well_formed procs; (p,ins,outs,c)  set procs; (p,ins',outs',c')  set procs
   ins = ins'  outs = outs'  c = c'"
  apply(auto simp:well_formed_def distinct_fst_def distinct_map inj_on_def)
by(erule_tac x="(p,ins,outs,c)" in ballE,auto)+


lemma PCFG_sourcelabel_None_less_num_nodes:
  "prog,procs  (Main,Label l) -et n'; well_formed procs  l < #:prog"
proof(induct "(Main,Label l)" et n' 
      arbitrary:l rule:PCFG.induct)
  case (Main et n')
  from prog  Label l -IEdge etp n'
  show ?case by(fastforce elim:Proc_CFG_sourcelabel_less_num_nodes)
next
  case (MainCall l p es rets n' ins outs c)
  from prog  Label l -CEdge (p,es,rets)p n'
  show ?case by(fastforce elim:Proc_CFG_sourcelabel_less_num_nodes)
next
  case (MainCallReturn p es rets n' l)
  from prog  Label l -CEdge (p, es, rets)p n'
  show ?case by(fastforce elim:Proc_CFG_sourcelabel_less_num_nodes)
qed auto

lemma Proc_CFG_sourcelabel_Some_less_num_nodes:
  "prog,procs  (p,Label l) -et n'; (p,ins,outs,c)  set procs; 
    well_formed procs  l < #:c"
proof(induct "(p,Label l)" et n' arbitrary:l rule:PCFG.induct)
  case (Proc ins' outs' c' et n')
  from c'  Label l -IEdge etp n' have "l < #:c'"
    by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  with ‹well_formed procs (p,ins,outs,c)  set procs 
    (p,ins',outs',c')  set procs
  show ?case by fastforce
next
  case (ProcCall ins' outs' c' l' p' es rets l'' ins'' outs'' c'' ps)
  from c'  Label l' -CEdge (p',es,rets)p Label l'' have "l' < #:c'"
    by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  with ‹well_formed procs (p,ins,outs,c)  set procs 
    (p, ins', outs', c')  set procs
  show ?case by fastforce
next
  case (ProcCallReturn ins' outs' c' p' es rets n')
  from c'  Label l -CEdge (p', es, rets)p n' have "l < #:c'"
    by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
  with ‹well_formed procs (p,ins,outs,c)  set procs 
    (p,ins',outs',c')  set procs
  show ?case by fastforce
qed auto


lemma Proc_CFG_targetlabel_Main_less_num_nodes:
  "prog,procs  n -et (Main,Label l); well_formed procs  l < #:prog"
proof(induct n et "(Main,Label l)" 
      arbitrary:l rule:PCFG.induct)
  case (Main n et)
  from prog  n -IEdge etp Label l
  show ?case by(fastforce elim:Proc_CFG_targetlabel_less_num_nodes)
next
  case (MainReturn l' p es rets l'' ins outs c)
  from prog  Label l' -CEdge (p,es,rets)p Label l'' 
  show ?case by(fastforce elim:Proc_CFG_targetlabel_less_num_nodes)
next
  case (MainCallReturn n p es rets)
  from prog  n -CEdge (p, es, rets)p Label l
  show ?case by(fastforce elim:Proc_CFG_targetlabel_less_num_nodes)
qed auto


lemma Proc_CFG_targetlabel_Some_less_num_nodes:
  "prog,procs  n -et (p,Label l); (p,ins,outs,c)  set procs; 
    well_formed procs  l < #:c"
proof(induct n et "(p,Label l)" arbitrary:l rule:PCFG.induct)
  case (Proc ins' outs' c' n et)
  from c'  n -IEdge etp Label l have "l < #:c'"
    by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
  with ‹well_formed procs (p,ins,outs,c)  set procs 
    (p,ins',outs',c')  set procs
  show ?case by fastforce
next
  case (ProcReturn ins' outs' c' l' p' es rets l ins'' outs'' c'' ps)
  from c'  Label l' -CEdge (p',es,rets)p Label l have "l < #:c'"
    by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
  with ‹well_formed procs (p,ins,outs,c)  set procs 
    (p, ins', outs', c')  set procs
  show ?case by fastforce
next
  case (ProcCallReturn ins' outs' c' n p'' es rets)
  from c'  n -CEdge (p'', es, rets)p Label l have "l < #:c'"
    by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
  with ‹well_formed procs (p,ins,outs,c)  set procs 
    (p,ins',outs',c')  set procs
  show ?case by fastforce
qed auto


lemma Proc_CFG_edge_det:
  "prog,procs  n -et n'; prog,procs  n -et' n'; well_formed procs
   et = et'"
proof(induct rule:PCFG.induct)
  case Main thus ?case by(auto elim:PCFG.cases dest:Proc_CFG_edge_det)
next
  case Proc thus ?case by(auto elim:PCFG.cases dest:Proc_CFG_edge_det)
next
  case (MainCall l p es rets n' ins outs c)
  from prog,procs  (Main,Label l) -et' (p,Entry) ‹well_formed procs
  obtain es' rets' n'' ins' outs' c' 
    where "prog  Label l -CEdge (p,es',rets')p n''" 
    and "(p,ins',outs',c')  set procs" 
    and "et' = (λs. True):(Main,n'')pmap (λe cf. interpret e cf) es'"
    by(auto elim:PCFG.cases)
  from (p,ins,outs,c)  set procs (p,ins',outs',c')  set procs
    ‹well_formed procs
  have "ins = ins'" by fastforce
  from prog  Label l -CEdge (p,es,rets)p n'
    prog  Label l -CEdge (p,es',rets')p n''
  have "es = es'" and "n' = n''" by(auto dest:Proc_CFG_Call_nodes_eq)
  with et' = (λs. True):(Main,n'')pmap (λe cf. interpret e cf) es' ins = ins'
  show ?case by simp
next
  case (ProcCall p ins outs c l p' es' rets' l' ins' outs' c' ps)
  from prog,procs  (p,Label l) -et' (p',Entry) (p',ins',outs',c')  set procs 
    (p, ins, outs, c)  set procs ‹well_formed procs
    c  Label l -CEdge (p', es', rets')p Label l'
  show ?case
  proof(induct "(p,Label l)" et' "(p',Entry)" rule:PCFG.induct)
    case (ProcCall insx outsx cx es'x rets'x l'x ins'x outs'x c'x ps)
    from ‹well_formed procs (p, insx, outsx, cx)  set procs 
      (p, ins, outs, c)  set procs
    have [simp]:"cx = c" by auto
    from cx  Label l -CEdge (p', es'x, rets'x)p Label l'x
      c  Label l -CEdge (p', es', rets')p Label l'
    have [simp]:"es'x = es'" "l'x = l'" by(auto dest:Proc_CFG_Call_nodes_eq)
    show ?case by simp
  qed auto
next
  case MainReturn
  thus ?case by -(erule PCFG.cases,auto dest:Proc_CFG_Call_nodes_eq')
next
  case (ProcReturn p ins outs c l p' es' rets' l' ins' outs' c' ps)
  from prog,procs  (p',Exit) -et' (p, Label l')
    (p, ins, outs, c)  set procs (p', ins', outs', c')  set procs
    c  Label l -CEdge (p', es', rets')p Label l' 
    ‹containsCall procs prog ps p ‹well_formed procs
  show ?case
  proof(induct "(p',Exit)" et' "(p,Label l')" rule:PCFG.induct)
    case (ProcReturn insx outsx cx lx es'x rets'x ins'x outs'x c'x psx)
    from (p', ins'x, outs'x, c'x)  set procs
      (p', ins', outs', c')  set procs ‹well_formed procs
    have [simp]:"outs'x = outs'" by fastforce
    from (p, insx, outsx, cx)  set procs (p, ins, outs, c)  set procs
      ‹well_formed procs
    have [simp]:"cx = c" by auto
    from cx  Label lx -CEdge (p', es'x, rets'x)p Label l'
      c  Label l -CEdge (p', es', rets')p Label l'
    have [simp]:"rets'x = rets'" by(fastforce dest:Proc_CFG_Call_nodes_eq')
    show ?case by simp
  qed auto
next
  case MainCallReturn thus ?case by(auto elim:PCFG.cases dest:Proc_CFG_edge_det)
next
  case ProcCallReturn thus ?case by(auto elim:PCFG.cases dest:Proc_CFG_edge_det)
qed


lemma Proc_CFG_deterministic:
  "prog,procs  n1 -et1 n1'; prog,procs  n2 -et2 n2'; n1 = n2; n1'  n2'; 
   intra_kind et1; intra_kind et2; well_formed procs
   Q Q'. et1 = (Q)  et2 = (Q')  
            (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))"
proof(induct arbitrary:n2 n2' rule:PCFG.induct)
  case (Main n et n')
  from prog,procs  n2 -et2 n2' (Main,n) = n2
    ‹intra_kind et2 ‹well_formed procs
  obtain m m' where "(Main,m) = n2" and "(Main,m') = n2'"
    and disj:"prog  m -IEdge et2p m'  
    (p es rets. prog  m -CEdge (p,es,rets)p m'  et2 = (λs. False))"
    by(induct rule:PCFG.induct)(fastforce simp:intra_kind_def)+
  from disj show ?case
  proof
    assume "prog  m -IEdge et2p m'"
    with (Main,m) = n2 (Main,m') = n2' 
      prog  n -IEdge etp n' (Main,n) = n2 (Main,n')  n2'
    show ?thesis by(auto dest:WCFG_deterministic)
  next
    assume "p es rets. prog  m -CEdge (p, es, rets)p m'  et2 = (λs. False)"
    with (Main,m) = n2 (Main,m') = n2' 
      prog  n -IEdge etp n' (Main,n) = n2 (Main,n')  n2'
    have False by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_source)
    thus ?thesis by simp
  qed
next
  case (Proc p ins outs c n et n')
  from prog,procs  n2 -et2 n2' (p,n) = n2 ‹intra_kind et2
    (p,ins,outs,c)  set procs ‹well_formed procs
  obtain m m' where "(p,m) = n2" and "(p,m') = n2'"
    and disj:"c  m -IEdge et2p m'  
    (p' es' rets'. c  m -CEdge (p',es',rets')p m'  et2 = (λs. False))"
    by(induct rule:PCFG.induct)(fastforce simp:intra_kind_def)+
  from disj show ?case
  proof
    assume "c  m -IEdge et2p m'"
    with (p,m) = n2 (p,m') = n2' 
      c  n -IEdge etp n' (p,n) = n2 (p,n')  n2'
    show ?thesis by(auto dest:WCFG_deterministic)
  next
    assume "p' es' rets'. c  m -CEdge (p', es', rets')p m'  et2 = (λs. False)"
    with (p,m) = n2 (p,m') = n2' 
      c  n -IEdge etp n' (p,n) = n2 (p,n')  n2'
    have False by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_source)
    thus ?thesis by simp
  qed
next
  case (MainCallReturn n p es rets n' n2 n2')
  from prog,procs  n2 -et2 n2' (Main,n) = n2
    ‹intra_kind et2 ‹well_formed procs
  obtain m m' where "(Main,m) = n2" and "(Main,m') = n2'"
    and disj:"prog  m -IEdge et2p m'  
    (p es rets. prog  m -CEdge (p,es,rets)p m'  et2 = (λs. False))"
    by(induct rule:PCFG.induct)(fastforce simp:intra_kind_def)+
  from disj show ?case
  proof
    assume "prog  m -IEdge et2p m'"
    with (Main,m) = n2 (Main,m') = n2' prog  n -CEdge (p, es, rets)p n'
      (Main, n) = n2 (Main, n')  n2'
    have False by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_source)
    thus ?thesis by simp
  next
    assume "p es rets. prog  m -CEdge (p,es,rets)p m'  et2 = (λs. False)"
    with (Main,m) = n2 (Main,m') = n2' prog  n -CEdge (p, es, rets)p n'
      (Main, n) = n2 (Main, n')  n2'
    show ?thesis by(fastforce dest:Proc_CFG_Call_nodes_eq)
  qed
next
  case (ProcCallReturn p ins outs c n p' es rets n' ps n2 n2')
  from prog,procs  n2 -et2 n2' (p,n) = n2 ‹intra_kind et2
    (p,ins,outs,c)  set procs ‹well_formed procs
  obtain m m' where "(p,m) = n2" and "(p,m') = n2'"
    and disj:"c  m -IEdge et2p m'  
    (p' es' rets'. c  m -CEdge (p',es',rets')p m'  et2 = (λs. False))"
    by(induct rule:PCFG.induct)(fastforce simp:intra_kind_def)+
  from disj show ?case
  proof
    assume "c  m -IEdge et2p m'"
    with (p,m) = n2 (p,m') = n2' 
      c  n -CEdge (p', es, rets)p n' (p,n) = n2 (p,n')  n2'
    have False by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_source)
    thus ?thesis by simp
  next
    assume "p' es' rets'. c  m -CEdge (p', es', rets')p m'  et2 = (λs. False)"
    with (p,m) = n2 (p,m') = n2' 
      c  n -CEdge (p', es, rets)p n' (p,n) = n2 (p,n')  n2'
    show ?thesis by(fastforce dest:Proc_CFG_Call_nodes_eq)
  qed
qed(auto simp:intra_kind_def)


subsection ‹Well-formedness of programs in combination with a procedure list.›

definition wf :: "cmd  procs  bool"
  where "wf prog procs  well_formed procs  
  (ps p. containsCall procs prog ps p  (ins outs c. (p,ins,outs,c)  set procs  
          (c' n n' es rets. c'  n -CEdge (p,es,rets)p n' 
               distinct rets  length rets = length outs  length es = length ins)))"


lemma wf_well_formed [intro]:"wf prog procs  well_formed procs"
  by(simp add:wf_def)


lemma wf_distinct_rets [intro]:
  "wf prog procs; containsCall procs prog ps p; (p,ins,outs,c)  set procs;
    c'  n -CEdge (p,es,rets)p n'  distinct rets"
by(fastforce simp:wf_def)


lemma
  assumes "wf prog procs" and "containsCall procs prog ps p"
  and "(p,ins,outs,c)  set procs" and "c'  n -CEdge (p,es,rets)p n'"
  shows wf_length_retsI [intro]:"length rets = length outs"
  and wf_length_esI [intro]:"length es = length ins"
proof -
  from ‹wf prog procs have "well_formed procs" by fastforce
  from assms
  obtain ins' outs' c' where "(p,ins',outs',c')  set procs"
    and lengths:"length rets = length outs'" "length es = length ins'"
    by(simp add:wf_def) blast
  from (p,ins,outs,c)  set procs (p,ins',outs',c')  set procs
    ‹well_formed procs
  have "ins' = ins" "outs' = outs" "c' = c" by auto
  with lengths show "length rets = length outs" "length es = length ins"
    by simp_all
qed


subsection ‹Type of well-formed programs›

definition "wf_prog = {(prog,procs). wf prog procs}"

typedef wf_prog = wf_prog
  unfolding wf_prog_def
  apply (rule_tac x="(Skip,[])" in exI)
  apply (simp add:wf_def well_formed_def)
  done

lemma wf_wf_prog:"Rep_wf_prog wfp = (prog,procs)  wf prog procs"
using Rep_wf_prog[of wfp] by(simp add:wf_prog_def)


lemma wfp_Seq1: assumes "Rep_wf_prog wfp = (c1;; c2, procs)"
  obtains wfp' where "Rep_wf_prog wfp' = (c1, procs)"
using ‹Rep_wf_prog wfp = (c1;; c2, procs)
apply(cases wfp) apply(auto simp:Abs_wf_prog_inverse wf_prog_def wf_def)
apply(erule_tac x="Abs_wf_prog (c1, procs)" in meta_allE)
by(auto elim:meta_mp simp:Abs_wf_prog_inverse wf_prog_def wf_def)

lemma wfp_Seq2: assumes "Rep_wf_prog wfp = (c1;; c2, procs)"
  obtains wfp' where "Rep_wf_prog wfp' = (c2, procs)"
using ‹Rep_wf_prog wfp = (c1;; c2, procs)
apply(cases wfp) apply(auto simp:Abs_wf_prog_inverse wf_prog_def wf_def)
apply(erule_tac x="Abs_wf_prog (c2, procs)" in meta_allE)
by(auto elim:meta_mp simp:Abs_wf_prog_inverse wf_prog_def wf_def)

lemma wfp_CondTrue: assumes "Rep_wf_prog wfp = (if (b) c1 else c2, procs)"
  obtains wfp' where "Rep_wf_prog wfp' = (c1, procs)"
using ‹Rep_wf_prog wfp = (if (b) c1 else c2, procs)
apply(cases wfp) apply(auto simp:Abs_wf_prog_inverse wf_prog_def wf_def)
apply(erule_tac x="Abs_wf_prog (c1, procs)" in meta_allE)
by(auto elim:meta_mp simp:Abs_wf_prog_inverse wf_prog_def wf_def)

lemma wfp_CondFalse: assumes "Rep_wf_prog wfp = (if (b) c1 else c2, procs)"
  obtains wfp' where "Rep_wf_prog wfp' = (c2, procs)"
using ‹Rep_wf_prog wfp = (if (b) c1 else c2, procs)
apply(cases wfp) apply(auto simp:Abs_wf_prog_inverse wf_prog_def wf_def)
apply(erule_tac x="Abs_wf_prog (c2, procs)" in meta_allE)
by(auto elim:meta_mp simp:Abs_wf_prog_inverse wf_prog_def wf_def)

lemma wfp_WhileBody: assumes "Rep_wf_prog wfp = (while (b) c', procs)"
  obtains wfp' where "Rep_wf_prog wfp' = (c', procs)"
using ‹Rep_wf_prog wfp = (while (b) c', procs)
apply(cases wfp) apply(auto simp:Abs_wf_prog_inverse wf_prog_def wf_def)
apply(erule_tac x="Abs_wf_prog (c', procs)" in meta_allE)
by(auto elim:meta_mp simp:Abs_wf_prog_inverse wf_prog_def wf_def)

lemma wfp_Call: assumes "Rep_wf_prog wfp = (prog,procs)"
  and "(p,ins,outs,c)  set procs" and "containsCall procs prog ps p"
  obtains wfp' where "Rep_wf_prog wfp' = (c,procs)"
using assms
apply(cases wfp) apply(auto simp:Abs_wf_prog_inverse wf_prog_def wf_def)
apply(erule_tac x="Abs_wf_prog (c, procs)" in meta_allE)
apply(erule meta_mp) apply(rule Abs_wf_prog_inverse)
by(auto dest:containsCall_indirection simp:wf_prog_def wf_def)



end

Theory Interpretation

section ‹Instantiate CFG locales with Proc CFG›

theory Interpretation imports WellFormProgs "../StaticInter/CFGExit" begin

subsection ‹Lifting of the basic definitions›

abbreviation sourcenode :: "edge  node"
  where "sourcenode e  fst e"

abbreviation targetnode :: "edge  node"
  where "targetnode e  snd(snd e)"

abbreviation kind :: "edge  (vname,val,node,pname) edge_kind"
  where "kind e  fst(snd e)"


definition valid_edge :: "wf_prog  edge  bool"
  where "valid_edge wfp a  let (prog,procs) = Rep_wf_prog wfp in
  prog,procs  sourcenode a -kind a targetnode a"


definition get_return_edges :: "wf_prog  edge  edge set"
  where "get_return_edges wfp a  
  case kind a of Q:rpfs  {a'. valid_edge wfp a'  (Q' f'. kind a' = Q'pf') 
                                 targetnode a' = r}
                     | _  {}"


lemma get_return_edges_non_call_empty:
  "Q r p fs. kind a  Q:rpfs  get_return_edges wfp a = {}"
  by(cases "kind a",auto simp:get_return_edges_def)


lemma call_has_return_edge:
  assumes "valid_edge wfp a" and "kind a = Q:rpfs"
  obtains a' where "valid_edge wfp a'" and "Q' f'. kind a' = Q'pf'"
  and "targetnode a' = r"
proof(atomize_elim)
  from ‹valid_edge wfp a ‹kind a = Q:rpfs
  obtain prog procs where "Rep_wf_prog wfp = (prog,procs)"
    and "prog,procs  sourcenode a -Q:rpfs targetnode a"
    by(fastforce simp:valid_edge_def)
  from prog,procs  sourcenode a -Q:rpfs targetnode a
  show "a'. valid_edge wfp a'  (Q' f'. kind a' = Q'pf')  targetnode a' = r"
  proof(induct "sourcenode a" "Q:rpfs" "targetnode a" rule:PCFG.induct)
    case (MainCall l es rets n' ins outs c)
    from prog  Label l -CEdge (p, es, rets)p n' obtain l' 
      where [simp]:"n' = Label l'"
      by(fastforce dest:Proc_CFG_Call_Labels)
    from MainCall
    have "prog,procs  (p,Exit) -(λcf. snd cf = (Main,Label l'))p
      (λcf cf'. cf'(rets [:=] map cf outs)) (Main,Label l')"
      by(fastforce intro:MainReturn)
    with ‹Rep_wf_prog wfp = (prog,procs) (Main, n') = r show ?thesis
      by(fastforce simp:valid_edge_def)
  next
    case (ProcCall px ins outs c l es' rets' l' ins' outs' c' ps)
    from ProcCall have "prog,procs  (p,Exit) -(λcf. snd cf = (px,Label l'))p
      (λcf cf'. cf'(rets' [:=] map cf outs')) (px,Label l')"
      by(fastforce intro:ProcReturn)
    with ‹Rep_wf_prog wfp = (prog,procs) (px, Label l') = r show ?thesis
      by(fastforce simp:valid_edge_def)
  qed auto
qed


lemma get_return_edges_call_nonempty:
  "valid_edge wfp a; kind a = Q:rpfs  get_return_edges wfp a  {}"
by -(erule call_has_return_edge,(fastforce simp:get_return_edges_def)+)


lemma only_return_edges_in_get_return_edges:
  "valid_edge wfp a; kind a = Q:rpfs; a'  get_return_edges wfp a
   Q' f'. kind a' = Q'pf'"
by(cases "kind a",auto simp:get_return_edges_def)


abbreviation lift_procs :: "wf_prog  (pname × vname list × vname list) list"
  where "lift_procs wfp  let (prog,procs) = Rep_wf_prog wfp in
  map (λx. (fst x,fst(snd x),fst(snd(snd x)))) procs"


subsection ‹Instatiation of the CFG› locale›


interpretation ProcCFG:
  CFG sourcenode targetnode kind "valid_edge wfp" "(Main,Entry)"
  get_proc "get_return_edges wfp" "lift_procs wfp" Main
  for wfp
proof -
  from Rep_wf_prog[of wfp]
  obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)" 
    by(fastforce simp:wf_prog_def)
  hence wf:"well_formed procs" by(fastforce intro:wf_wf_prog)
  show "CFG sourcenode targetnode kind (valid_edge wfp) (Main, Entry)
    get_proc (get_return_edges wfp) (lift_procs wfp) Main"
  proof
    fix a assume "valid_edge wfp a" and "targetnode a = (Main, Entry)"
    from this wf show False by(auto elim:PCFG.cases simp:valid_edge_def) 
  next
    show "get_proc (Main, Entry) = Main" by simp
  next
    fix a Q r p fs 
    assume "valid_edge wfp a" and "kind a = Q:rpfs"
      and "sourcenode a = (Main, Entry)"
    thus False by(auto elim:PCFG.cases simp:valid_edge_def)
  next
    fix a a' 
    assume "valid_edge wfp a" and "valid_edge wfp a'"
      and "sourcenode a = sourcenode a'" and "targetnode a = targetnode a'"
    with wf show "a = a'"
      by(cases a,cases a',auto dest:Proc_CFG_edge_det simp:valid_edge_def)
  next
    fix a Q r f
    assume "valid_edge wfp a" and "kind a = Q:rMainf"
    from this wf show False by(auto elim:PCFG.cases simp:valid_edge_def)
  next
    fix a Q' f'
    assume "valid_edge wfp a" and "kind a = Q'Mainf'"
    from this wf show False by(auto elim:PCFG.cases simp:valid_edge_def)
  next
    fix a Q r p fs
    assume "valid_edge wfp a" and "kind a = Q:rpfs"
    thus "ins outs. (p, ins, outs)  set (lift_procs wfp)"
      apply(auto simp:valid_edge_def) apply(erule PCFG.cases) apply auto
         apply(fastforce dest:Proc_CFG_IEdge_intra_kind simp:intra_kind_def)
        apply(fastforce dest:Proc_CFG_IEdge_intra_kind simp:intra_kind_def)
       apply(rule_tac x="ins" in exI) apply(rule_tac x="outs" in exI)
       apply(rule_tac x="(p,ins,outs,c)" in image_eqI) apply auto
      apply(rule_tac x="ins'" in exI) apply(rule_tac x="outs'" in exI)
      apply(rule_tac x="(p,ins',outs',c')" in image_eqI) by(auto simp:set_conv_nth)
  next
    fix a assume "valid_edge wfp a" and "intra_kind (kind a)"
    thus "get_proc (sourcenode a) = get_proc (targetnode a)"
      by(auto elim:PCFG.cases simp:valid_edge_def intra_kind_def)
  next
    fix a Q r p fs
    assume "valid_edge wfp a" and "kind a = Q:rpfs"
    thus "get_proc (targetnode a) = p" by(auto elim:PCFG.cases simp:valid_edge_def) 
  next
    fix a Q' p f'
    assume "valid_edge wfp a" and "kind a = Q'pf'"
    thus "get_proc (sourcenode a) = p" by(auto elim:PCFG.cases simp:valid_edge_def) 
  next
    fix a Q r p fs
    assume "valid_edge wfp a" and "kind a = Q:rpfs"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from this ‹kind a = Q:rpfs 
    show "a'. valid_edge wfp a'  targetnode a' = targetnode a 
      (Qx rx fsx. kind a' = Qx:rxpfsx)"
    proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
      case (MainCall l p' es rets n' ins outs c)
      from λs. True:(Main, n')p'map interpret es = kind a ‹kind a = Q:rpfs
      have [simp]:"p' = p" by simp
      { fix a' assume "valid_edge wfp a'" and "targetnode a' = (p', Entry)"
        hence "Qx rx fsx. kind a' = Qx:rxpfsx"
          by(auto elim:PCFG.cases simp:valid_edge_def) }
      with (p',Entry) = targetnode a show ?case by simp
    next
      case (ProcCall px ins outs c l p' es rets l' ins' outs' c' ps)
      from λs. True:(px, Label l')p'map interpret es = kind a ‹kind a = Q:rpfs
      have [simp]:"p' = p" by simp
      { fix a' assume "valid_edge wfp a'" and "targetnode a' = (p', Entry)"
        hence "Qx rx fsx. kind a' = Qx:rxpfsx" 
          by(auto elim:PCFG.cases simp:valid_edge_def) }
      with (p', Entry) = targetnode a show ?case by simp
    qed auto
  next
    fix a Q' p f'
    assume "valid_edge wfp a" and "kind a = Q'pf'"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from this ‹kind a = Q'pf'
    show "a'. valid_edge wfp a'  sourcenode a' = sourcenode a 
      (Qx fx. kind a' = Qxpfx)"
    proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
      case (MainReturn l p' es rets l' ins outs c)
      from λcf. snd cf = (Main, Label l')p'λcf cf'. cf'(rets [:=] map cf outs) =
        kind a ‹kind a = Q'pf' have [simp]:"p' = p" by simp
      { fix a' assume "valid_edge wfp a'" and "sourcenode a' = (p', Exit)"
        hence "Qx fx. kind a' = Qxpfx" 
          by(auto elim:PCFG.cases simp:valid_edge_def) }
      with (p', Exit) = sourcenode a show ?case by simp
    next
      case (ProcReturn px ins outs c l p' es rets l' ins' outs' c' ps)
      from λcf. snd cf = (px, Label l')p'λcf cf'. cf'(rets [:=] map cf outs') =
        kind a ‹kind a = Q'pf' have [simp]:"p' = p" by simp
      { fix a' assume "valid_edge wfp a'" and "sourcenode a' = (p', Exit)"
        hence "Qx fx. kind a' = Qxpfx" 
          by(auto elim:PCFG.cases simp:valid_edge_def) }
      with (p', Exit) = sourcenode a show ?case by simp
    qed auto
  next
    fix a Q r p fs
    assume "valid_edge wfp a" and "kind a = Q:rpfs"
    thus "get_return_edges wfp a  {}" by(rule get_return_edges_call_nonempty)
  next
    fix a a'
    assume "valid_edge wfp a" and "a'  get_return_edges wfp a"
    thus "valid_edge wfp a'"
      by(cases "kind a",auto simp:get_return_edges_def)
  next
    fix a a'
    assume "valid_edge wfp a" and "a'  get_return_edges wfp a"
    thus "Q r p fs. kind a = Q:rpfs"
      by(cases "kind a")(auto simp:get_return_edges_def)
  next
    fix a Q r p fs a'
    assume "valid_edge wfp a" and "kind a = Q:rpfs"
      and "a'  get_return_edges wfp a"
    thus "Q' f'. kind a' = Q'pf'" by(rule only_return_edges_in_get_return_edges)
  next
    fix a Q' p f'
    assume "valid_edge wfp a" and "kind a = Q'pf'"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from this ‹kind a = Q'pf'
    show "∃!a'. valid_edge wfp a'  (Q r fs. kind a' = Q:rpfs) 
      a  get_return_edges wfp a'"
    proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
      case (MainReturn l px es rets l' ins outs c)
      from λcf. snd cf = (Main, Label l')pxλcf cf'. cf'(rets [:=] map cf outs) =
        kind a ‹kind a = Q'pf' have [simp]:"px = p" by simp
      from prog  Label l -CEdge (px, es, rets)p Label l' have "l' = Suc l"
        by(fastforce dest:Proc_CFG_Call_Labels)
      from prog  Label l -CEdge (px, es, rets)p Label l'
      have "containsCall procs prog [] px" by(rule Proc_CFG_Call_containsCall)
      with prog  Label l -CEdge (px, es, rets)p Label l'
        (px, ins, outs, c)  set procs        
      have "prog,procs  (p,Exit) -(λcf. snd cf = (Main,Label l'))p
        (λcf cf'. cf'(rets [:=] map cf outs)) (Main,Label l')"
        by(fastforce intro:PCFG.MainReturn)
      with (px, Exit) = sourcenode a (Main, Label l') = targetnode a
        λcf. snd cf = (Main, Label l')pxλcf cf'. cf'(rets [:=] map cf outs) =
        kind a
      have edge:"prog,procs  sourcenode a -kind a targetnode a" by simp
      from prog  Label l -CEdge (px, es, rets)p Label l'
        (px, ins, outs, c)  set procs
      have edge':"prog,procs  (Main,Label l) 
        -(λs. True):(Main,Label l')pmap (λe cf. interpret e cf) es (p,Entry)"
        by(fastforce intro:MainCall)
      show ?case
      proof(rule ex_ex1I)
        from edge edge' (Main, Label l') = targetnode a 
          l' = Suc l ‹kind a = Q'pf'
        show "a'. valid_edge wfp a' 
          (Q r fs. kind a' = Q:rpfs)  a  get_return_edges wfp a'"
          by(fastforce simp:valid_edge_def get_return_edges_def)
      next
        fix a' a''
        assume "valid_edge wfp a' 
          (Q r fs. kind a' = Q:rpfs)  a  get_return_edges wfp a'"
          and "valid_edge wfp a'' 
          (Q r fs. kind a'' = Q:rpfs)  a  get_return_edges wfp a''"
        then obtain Q r fs Q' r' fs' where "valid_edge wfp a'"
          and "kind a' = Q:rpfs" and "a  get_return_edges wfp a'"
          and "valid_edge wfp a''" and "kind a'' = Q':r'pfs'"
          and "a  get_return_edges wfp a''" by blast
        from ‹valid_edge wfp a' ‹kind a' = Q:rpfs[THEN sym] edge wf l' = Suc l
          a  get_return_edges wfp a' (Main, Label l') = targetnode a
        have nodes:"sourcenode a' = (Main,Label l)  targetnode a' = (p,Entry)"
          apply(auto simp:valid_edge_def get_return_edges_def)
          by(erule PCFG.cases,auto dest:Proc_CFG_Call_Labels)+
        from ‹valid_edge wfp a'' ‹kind a'' = Q':r'pfs'[THEN sym] l' = Suc l
            a  get_return_edges wfp a'' (Main, Label l') = targetnode a wf edge'
        have nodes':"sourcenode a'' = (Main,Label l)  targetnode a'' = (p,Entry)"
          apply(auto simp:valid_edge_def get_return_edges_def)
          by(erule PCFG.cases,auto dest:Proc_CFG_Call_Labels)+
        with nodes ‹valid_edge wfp a' ‹valid_edge wfp a'' wf
        have "kind a' = kind a''"
          by(fastforce dest:Proc_CFG_edge_det simp:valid_edge_def)
        with nodes nodes' show "a' = a''" by(cases a',cases a'',auto)
      qed
    next
      case (ProcReturn p' ins outs c l px esx retsx l' ins' outs' c' ps)
      from λcf. snd cf = (p', Label l')pxλcf cf'. cf'(retsx [:=] map cf outs') =
        kind a ‹kind a = Q'pf' have [simp]:"px = p" by simp
      from c  Label l -CEdge (px, esx, retsx)p Label l' have "l' = Suc l"
        by(fastforce dest:Proc_CFG_Call_Labels)
      from (p',ins,outs,c)  set procs
        c  Label l -CEdge (px, esx, retsx)p Label l' 
        (px, ins', outs', c')  set procs ‹containsCall procs prog ps p'
      have "prog,procs  (p,Exit) -(λcf. snd cf = (p',Label l'))p
        (λcf cf'. cf'(retsx [:=] map cf outs')) (p',Label l')"
        by(fastforce intro:PCFG.ProcReturn)
      with (px, Exit) = sourcenode a (p', Label l') = targetnode a
        λcf. snd cf = (p', Label l')pxλcf cf'. cf'(retsx [:=] map cf outs') =
        kind a have edge:"prog,procs  sourcenode a -kind a targetnode a" by simp
      from (p',ins,outs,c)  set procs
        c  Label l -CEdge (px, esx, retsx)p Label l'
        (px, ins', outs', c')  set procs ‹containsCall procs prog ps p'
      have edge':"prog,procs  (p',Label l) 
        -(λs. True):(p',Label l')pmap (λe cf. interpret e cf) esx (p,Entry)"
        by(fastforce intro:ProcCall)
      show ?case
      proof(rule ex_ex1I)
        from edge edge' (p', Label l') = targetnode a l' = Suc l
          (p', ins, outs, c)  set procs ‹kind a = Q'pf'
        show "a'. valid_edge wfp a' 
          (Q r fs. kind a' = Q:rpfs)  a  get_return_edges wfp a'"
          by(fastforce simp:valid_edge_def get_return_edges_def)
      next
        fix a' a''
        assume "valid_edge wfp a' 
          (Q r fs. kind a' = Q:rpfs)  a  get_return_edges wfp a'"
          and "valid_edge wfp a'' 
          (Q r fs. kind a'' = Q:rpfs)  a  get_return_edges wfp a''"
        then obtain Q r fs Q' r' fs' where "valid_edge wfp a'"
          and "kind a' = Q:rpfs" and "a  get_return_edges wfp a'"
          and "valid_edge wfp a''" and "kind a'' = Q':r'pfs'"
          and "a  get_return_edges wfp a''" by blast
        from ‹valid_edge wfp a' ‹kind a' = Q:rpfs[THEN sym] 
          a  get_return_edges wfp a' edge (p', Label l') = targetnode a wf
          (p', ins, outs, c)  set procs l' = Suc l
        have nodes:"sourcenode a' = (p',Label l)  targetnode a' = (p,Entry)"
          apply(auto simp:valid_edge_def get_return_edges_def)
          by(erule PCFG.cases,auto dest:Proc_CFG_Call_Labels)+
        from ‹valid_edge wfp a'' ‹kind a'' = Q':r'pfs'[THEN sym] 
          a  get_return_edges wfp a'' edge (p', Label l') = targetnode a wf
          (p', ins, outs, c)  set procs l' = Suc l
        have nodes':"sourcenode a'' = (p',Label l)  targetnode a'' = (p,Entry)"
          apply(auto simp:valid_edge_def get_return_edges_def)
          by(erule PCFG.cases,auto dest:Proc_CFG_Call_Labels)+
        with nodes ‹valid_edge wfp a' ‹valid_edge wfp a'' wf
        have "kind a' = kind a''"
          by(fastforce dest:Proc_CFG_edge_det simp:valid_edge_def)
        with nodes nodes' show "a' = a''" by(cases a',cases a'',auto)
      qed
    qed auto
  next
    fix a a'
    assume "valid_edge wfp a" and "a'  get_return_edges wfp a"
    then obtain Q r p fs l'
      where "kind a = Q:rpfs" and "valid_edge wfp a'"
      by(cases "kind a")(fastforce simp:valid_edge_def get_return_edges_def)+
    from ‹valid_edge wfp a ‹kind a = Q:rpfs a'  get_return_edges wfp a
    obtain Q' f' where "kind a' = Q'pf'" 
      by(fastforce dest!:only_return_edges_in_get_return_edges)
    with ‹valid_edge wfp a' have "sourcenode a' = (p,Exit)"
      by(auto elim:PCFG.cases simp:valid_edge_def)
    from ‹valid_edge wfp a ‹kind a = Q:rpfs
    have "prog,procs  sourcenode a -Q:rpfs targetnode a"
      by(simp add:valid_edge_def)
    thus "a''. valid_edge wfp a''  sourcenode a'' = targetnode a  
      targetnode a'' = sourcenode a'  kind a'' = (λcf. False)"
    proof(induct "sourcenode a" "Q:rpfs" "targetnode a" rule:PCFG.induct)
      case (MainCall l es rets n' ins outs c)
      have "c  Entry -IEdge (λs. False)p Exit" by(rule Proc_CFG_Entry_Exit)
      moreover
      from prog  Label l -CEdge (p, es, rets)p n'
      have "containsCall procs prog [] p" by(rule Proc_CFG_Call_containsCall)
      ultimately have "prog,procs  (p,Entry) -(λs. False) (p,Exit)"
        using (p, ins, outs, c)  set procs by(fastforce intro:Proc)
      with ‹sourcenode a' = (p,Exit) (p, Entry) = targetnode a[THEN sym]
      show ?case by(fastforce simp:valid_edge_def)
    next
      case (ProcCall px ins outs c l es' rets' l' ins' outs' c' ps)
      have "c'  Entry -IEdge (λs. False)p Exit" by(rule Proc_CFG_Entry_Exit)
      moreover
      from c  Label l -CEdge (p, es', rets')p Label l'
      have "containsCall procs c [] p" by(rule Proc_CFG_Call_containsCall)
      with ‹containsCall procs prog ps px (px,ins,outs,c)  set procs
      have "containsCall procs prog (ps@[px]) p"
        by(rule containsCall_in_proc)
      ultimately have "prog,procs  (p,Entry) -(λs. False) (p,Exit)"
        using (p, ins', outs', c')  set procs by(fastforce intro:Proc)
      with ‹sourcenode a' = (p,Exit) (p, Entry) = targetnode a[THEN sym]
      show ?case by(fastforce simp:valid_edge_def)
    qed auto
  next
    fix a a'
    assume "valid_edge wfp a" and "a'  get_return_edges wfp a"
    then obtain Q r p fs l'
      where "kind a = Q:rpfs" and "valid_edge wfp a'"
      by(cases "kind a")(fastforce simp:valid_edge_def get_return_edges_def)+
    from ‹valid_edge wfp a ‹kind a = Q:rpfs a'  get_return_edges wfp a
    obtain Q' f' where "kind a' = Q'pf'" and "targetnode a' = r"
      by(auto simp:get_return_edges_def)
    from ‹valid_edge wfp a ‹kind a = Q:rpfs
    have "prog,procs  sourcenode a -Q:rpfs targetnode a"
      by(simp add:valid_edge_def)
    thus "a''. valid_edge wfp a''  sourcenode a'' = sourcenode a  
      targetnode a'' = targetnode a'  kind a'' = (λcf. False)"
    proof(induct "sourcenode a" "Q:rpfs" "targetnode a" rule:PCFG.induct)
      case (MainCall l es rets n' ins outs c)
      from prog  Label l -CEdge (p, es, rets)p n'
      have "prog,procs  (Main,Label l) -(λs. False) (Main,n')"
        by(rule MainCallReturn)
      with (Main, Label l) = sourcenode a[THEN sym] ‹targetnode a' = r
        (Main, n') = r[THEN sym]
      show ?case by(auto simp:valid_edge_def)
    next
      case (ProcCall px ins outs c l es' rets' l' ins' outs' c' ps)
      from (px,ins,outs,c)  set procs         ‹containsCall procs prog ps px
        c  Label l -CEdge (p, es', rets')p Label l'
      have "prog,procs  (px,Label l) -(λs. False) (px,Label l')"
        by(fastforce intro:ProcCallReturn)
      with (px, Label l) = sourcenode a[THEN sym] ‹targetnode a' = r
        (px, Label l') = r[THEN sym]
      show ?case by(auto simp:valid_edge_def)
    qed auto
  next
    fix a Q r p fs
    assume "valid_edge wfp a" and "kind a = Q:rpfs"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from this ‹kind a = Q:rpfs 
    show "∃!a'. valid_edge wfp a' 
      sourcenode a' = sourcenode a  intra_kind (kind a')"
    proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
      case (MainCall l p' es rets n' ins outs c)
      show ?thesis 
      proof(rule ex_ex1I)
        from prog  Label l -CEdge (p', es, rets)p n'
        have "prog,procs  (Main,Label l) -(λs. False) (Main,n')"
          by(rule MainCallReturn)
        with (Main, Label l) = sourcenode a[THEN sym]
        show "a'. valid_edge wfp a' 
          sourcenode a' = sourcenode a  intra_kind (kind a')"
          by(fastforce simp:valid_edge_def intra_kind_def) 
      next
        fix a' a'' 
        assume "valid_edge wfp a'  sourcenode a' = sourcenode a  
          intra_kind (kind a')" and "valid_edge wfp a'' 
          sourcenode a'' = sourcenode a  intra_kind (kind a'')"
        hence "valid_edge wfp a'" and "sourcenode a' = sourcenode a"
          and "intra_kind (kind a')" and "valid_edge wfp a''"
          and "sourcenode a'' = sourcenode a" and "intra_kind (kind a'')" by simp_all
        from ‹valid_edge wfp a' ‹sourcenode a' = sourcenode a
          ‹intra_kind (kind a') prog  Label l -CEdge (p', es, rets)p n'
          (Main, Label l) = sourcenode a wf
        have "targetnode a' = (Main,Label (Suc l))"
          by(auto elim!:PCFG.cases dest:Proc_CFG_Call_Intra_edge_not_same_source 
            Proc_CFG_Call_Labels simp:intra_kind_def valid_edge_def)
        from ‹valid_edge wfp a'' ‹sourcenode a'' = sourcenode a
          ‹intra_kind (kind a'') prog  Label l -CEdge (p', es, rets)p n'
          (Main, Label l) = sourcenode a wf
        have "targetnode a'' = (Main,Label (Suc l))"
          by(auto elim!:PCFG.cases dest:Proc_CFG_Call_Intra_edge_not_same_source 
            Proc_CFG_Call_Labels simp:intra_kind_def valid_edge_def)
        with ‹valid_edge wfp a' ‹sourcenode a' = sourcenode a
          ‹valid_edge wfp a'' ‹sourcenode a'' = sourcenode a
          ‹targetnode a' = (Main,Label (Suc l)) wf
        show "a' = a''" by(cases a',cases a'')
        (auto dest:Proc_CFG_edge_det simp:valid_edge_def)
      qed
    next
      case (ProcCall px ins outs c l p' es' rets' l' ins' outs' c' ps)
      show ?thesis 
      proof(rule ex_ex1I)
        from (px, ins, outs, c)  set procs ‹containsCall procs prog ps px
          c  Label l -CEdge (p', es', rets')p Label l'
        have "prog,procs  (px,Label l) -(λs. False) (px,Label l')"
          by -(rule ProcCallReturn)
        with (px, Label l) = sourcenode a[THEN sym]
        show "a'. valid_edge wfp a'  sourcenode a' = sourcenode a  
                   intra_kind (kind a')"
          by(fastforce simp:valid_edge_def intra_kind_def)
      next
        fix a' a'' 
        assume "valid_edge wfp a'  sourcenode a' = sourcenode a  
          intra_kind (kind a')" and "valid_edge wfp a'' 
          sourcenode a'' = sourcenode a  intra_kind (kind a'')"
        hence "valid_edge wfp a'" and "sourcenode a' = sourcenode a"
          and "intra_kind (kind a')" and "valid_edge wfp a''"
          and "sourcenode a'' = sourcenode a" and "intra_kind (kind a'')" by simp_all
        from ‹valid_edge wfp a' ‹sourcenode a' = sourcenode a
          ‹intra_kind (kind a') (px, ins, outs, c)  set procs
          c  Label l -CEdge (p', es', rets')p Label l'
          (p', ins', outs', c')  set procs wf
          ‹containsCall procs prog ps px (px, Label l) = sourcenode a
        have "targetnode a' = (px,Label (Suc l))"
          apply(auto simp:valid_edge_def) apply(erule PCFG.cases)
          by(auto dest:Proc_CFG_Call_Intra_edge_not_same_source 
            Proc_CFG_Call_nodes_eq Proc_CFG_Call_Labels simp:intra_kind_def)
        from ‹valid_edge wfp a'' ‹sourcenode a'' = sourcenode a
          ‹intra_kind (kind a'') (px, ins, outs, c)  set procs
          c  Label l -CEdge (p', es', rets')p Label l'
          (p', ins', outs', c')  set procs wf
          ‹containsCall procs prog ps px (px, Label l) = sourcenode a
        have "targetnode a'' = (px,Label (Suc l))"
          apply(auto simp:valid_edge_def) apply(erule PCFG.cases)
          by(auto dest:Proc_CFG_Call_Intra_edge_not_same_source 
            Proc_CFG_Call_nodes_eq Proc_CFG_Call_Labels simp:intra_kind_def)
        with ‹valid_edge wfp a' ‹sourcenode a' = sourcenode a
          ‹valid_edge wfp a'' ‹sourcenode a'' = sourcenode a
          ‹targetnode a' = (px,Label (Suc l)) wf
        show "a' = a''" by(cases a',cases a'')
        (auto dest:Proc_CFG_edge_det simp:valid_edge_def)
      qed
    qed auto
  next
    fix a Q' p f'
    assume "valid_edge wfp a" and "kind a = Q'pf'"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from this ‹kind a = Q'pf'
    show "∃!a'. valid_edge wfp a' 
      targetnode a' = targetnode a  intra_kind (kind a')"
    proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
      case (MainReturn l p' es rets l' ins outs c)
      show ?thesis 
      proof(rule ex_ex1I)
        from prog  Label l -CEdge (p', es, rets)p Label l'
        have "prog,procs  (Main,Label l) -(λs. False) 
          (Main,Label l')" by(rule MainCallReturn)
        with (Main, Label l') = targetnode a[THEN sym]
        show "a'. valid_edge wfp a' 
          targetnode a' = targetnode a  intra_kind (kind a')"
          by(fastforce simp:valid_edge_def intra_kind_def)
      next
        fix a' a''
        assume "valid_edge wfp a'  targetnode a' = targetnode a  
          intra_kind (kind a')" and "valid_edge wfp a'' 
          targetnode a'' = targetnode a  intra_kind (kind a'')"
        hence "valid_edge wfp a'" and "targetnode a' = targetnode a"
          and "intra_kind (kind a')" and "valid_edge wfp a''"
          and "targetnode a'' = targetnode a" and "intra_kind (kind a'')" by simp_all
        from ‹valid_edge wfp a' ‹targetnode a' = targetnode a
          ‹intra_kind (kind a') prog  Label l -CEdge (p', es, rets)p Label l'
          (Main, Label l') = targetnode a wf
        have "sourcenode a' = (Main,Label l)"
          apply(auto elim!:PCFG.cases dest:Proc_CFG_Call_Intra_edge_not_same_target 
                      simp:valid_edge_def intra_kind_def)
          by(fastforce dest:Proc_CFG_Call_nodes_eq' Proc_CFG_Call_Labels)
        from ‹valid_edge wfp a'' ‹targetnode a'' = targetnode a
          ‹intra_kind (kind a'') prog  Label l -CEdge (p', es, rets)p Label l'
          (Main, Label l') = targetnode a wf
        have "sourcenode a'' = (Main,Label l)"
          apply(auto elim!:PCFG.cases dest:Proc_CFG_Call_Intra_edge_not_same_target 
                      simp:valid_edge_def intra_kind_def)
          by(fastforce dest:Proc_CFG_Call_nodes_eq' Proc_CFG_Call_Labels)
        with ‹valid_edge wfp a' ‹targetnode a' = targetnode a
          ‹valid_edge wfp a'' ‹targetnode a'' = targetnode a
          ‹sourcenode a' = (Main,Label l) wf
        show "a' = a''" by(cases a',cases a'')
        (auto dest:Proc_CFG_edge_det simp:valid_edge_def)
      qed
    next
      case (ProcReturn px ins outs c l p' es' rets' l' ins' outs' c' ps)
      show ?thesis 
      proof(rule ex_ex1I)
        from (px, ins, outs, c)  set procs ‹containsCall procs prog ps px
          c  Label l -CEdge (p', es', rets')p Label l'
        have "prog,procs  (px,Label l) -(λs. False) (px,Label l')"
          by -(rule ProcCallReturn)
        with (px, Label l') = targetnode a[THEN sym]
        show "a'. valid_edge wfp a' 
          targetnode a' = targetnode a  intra_kind (kind a')"
          by(fastforce simp:valid_edge_def intra_kind_def)
      next
        fix a' a''
        assume "valid_edge wfp a'  targetnode a' = targetnode a  
          intra_kind (kind a')" and "valid_edge wfp a'' 
          targetnode a'' = targetnode a  intra_kind (kind a'')"
        hence "valid_edge wfp a'" and "targetnode a' = targetnode a"
          and "intra_kind (kind a')" and "valid_edge wfp a''"
          and "targetnode a'' = targetnode a" and "intra_kind (kind a'')" by simp_all
        from ‹valid_edge wfp a' ‹targetnode a' = targetnode a
          ‹intra_kind (kind a') (px, ins, outs, c)  set procs
          (p', ins', outs', c')  set procs wf
          c  Label l -CEdge (p', es', rets')p Label l'
          ‹containsCall procs prog ps px (px, Label l') = targetnode a
        have "sourcenode a' = (px,Label l)"
          apply(auto simp:valid_edge_def) apply(erule PCFG.cases)
          by(auto dest:Proc_CFG_Call_Intra_edge_not_same_target 
            Proc_CFG_Call_nodes_eq' simp:intra_kind_def)
        from ‹valid_edge wfp a'' ‹targetnode a'' = targetnode a
          ‹intra_kind (kind a'') (px, ins, outs, c)  set procs
          (p', ins', outs', c')  set procs wf
          c  Label l -CEdge (p', es', rets')p Label l'
          ‹containsCall procs prog ps px (px, Label l') = targetnode a
        have "sourcenode a'' = (px,Label l)"
          apply(auto simp:valid_edge_def) apply(erule PCFG.cases)
          by(auto dest:Proc_CFG_Call_Intra_edge_not_same_target 
            Proc_CFG_Call_nodes_eq' simp:intra_kind_def)
        with ‹valid_edge wfp a' ‹targetnode a' = targetnode a
          ‹valid_edge wfp a'' ‹targetnode a'' = targetnode a
          ‹sourcenode a' = (px,Label l) wf
        show "a' = a''" by(cases a',cases a'')
        (auto dest:Proc_CFG_edge_det simp:valid_edge_def)
      qed
    qed auto
  next
    fix a a' Q1 r1 p fs1 Q2 r2 fs2
    assume "valid_edge wfp a" and "valid_edge wfp a'"
      and "kind a = Q1:r1pfs1" and "kind a' = Q2:r2pfs2"
    thus "targetnode a = targetnode a'" by(auto elim!:PCFG.cases simp:valid_edge_def)
  next
    from wf show "distinct_fst (lift_procs wfp)"
      by(fastforce simp:well_formed_def distinct_fst_def o_def)
  next
    fix p ins outs assume "(p, ins, outs)  set (lift_procs wfp)"
    from (p, ins, outs)  set (lift_procs wfp) wf
    show "distinct ins" by(fastforce simp:well_formed_def wf_proc_def)
  next
    fix p ins outs assume "(p, ins, outs)  set (lift_procs wfp)"
    from (p, ins, outs)  set (lift_procs wfp) wf
    show "distinct outs" by(fastforce simp:well_formed_def wf_proc_def)
  qed
qed



subsection ‹Instatiation of the CFGExit› locale›


interpretation ProcCFGExit:
  CFGExit sourcenode targetnode kind "valid_edge wfp" "(Main,Entry)"
  get_proc "get_return_edges wfp" "lift_procs wfp" Main "(Main,Exit)"
  for wfp
proof -
  from Rep_wf_prog[of wfp]
  obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)" 
    by(fastforce simp:wf_prog_def)
  hence wf:"well_formed procs" by(fastforce intro:wf_wf_prog)
  show "CFGExit sourcenode targetnode kind (valid_edge wfp) (Main, Entry)
    get_proc (get_return_edges wfp) (lift_procs wfp) Main (Main, Exit)"
  proof
    fix a assume "valid_edge wfp a" and "sourcenode a = (Main, Exit)"
    with wf show False by(auto elim:PCFG.cases simp:valid_edge_def)
  next
    show "get_proc (Main, Exit) = Main" by simp
  next
    fix a Q p f
    assume "valid_edge wfp a" and "kind a = Qpf"
      and "targetnode a = (Main, Exit)"
    thus False by(auto elim:PCFG.cases simp:valid_edge_def)
  next
    have "prog,procs  (Main,Entry) -(λs. False) (Main,Exit)"
      by(fastforce intro:Main Proc_CFG_Entry_Exit)
    thus "a. valid_edge wfp a 
      sourcenode a = (Main, Entry) 
      targetnode a = (Main, Exit)  kind a = (λs. False)"
      by(fastforce simp:valid_edge_def)
  qed
qed


end

Theory Labels

section ‹Labels›

theory Labels imports Com begin

text ‹Labels describe a mapping from the inner node label 
  to the matching command›

inductive labels :: "cmd  nat  cmd  bool"
where

Labels_Base:
  "labels c 0 c"

| Labels_LAss:
  "labels (V:=e) 1 Skip"

| Labels_Seq1: 
  "labels c1 l c  labels (c1;;c2) l (c;;c2)"

| Labels_Seq2: 
  "labels c2 l c  labels (c1;;c2) (l + #:c1) c"

| Labels_CondTrue:
  "labels c1 l c  labels (if (b) c1 else c2) (l + 1) c"

| Labels_CondFalse:
  "labels c2 l c  labels (if (b) c1 else c2) (l + #:c1 + 1) c"

| Labels_WhileBody:
  "labels c' l c  labels (while(b) c') (l + 2) (c;;while(b) c')"

| Labels_WhileExit:
  "labels (while(b) c') 1 Skip"

| Labels_Call:
  "labels (Call p es rets) 1 Skip"


lemma label_less_num_inner_nodes:
  "labels c l c'  l < #:c"
proof(induct c arbitrary:l c')
  case Skip 
  from ‹labels Skip l c' show ?case by(fastforce elim:labels.cases)
next
  case (LAss V e) 
  from ‹labels (V:=e) l c' show ?case by(fastforce elim:labels.cases)
next
  case (Seq c1 c2)
  note IH1 = l c'. labels c1 l c'  l < #:c1
  note IH2 = l c'. labels c2 l c'  l < #:c2
  from ‹labels (c1;;c2) l c' IH1 IH2 show ?case
    by simp(erule labels.cases,auto,force)
next
  case (Cond b c1 c2)
  note IH1 = l c'. labels c1 l c'  l < #:c1
  note IH2 = l c'. labels c2 l c'  l < #:c2
  from ‹labels (if (b) c1 else c2) l c' IH1 IH2 show ?case
    by simp(erule labels.cases,auto,force)
next
  case (While b c)
  note IH = l c'. labels c l c'  l < #:c
  from ‹labels (while (b) c) l c' IH show ?case
    by simp(erule labels.cases,fastforce+)
next
  case (Call p es rets) 
  thus ?case by simp(erule labels.cases,fastforce+)
qed


declare One_nat_def [simp del]

lemma less_num_inner_nodes_label:
  assumes "l < #:c" obtains c' where "labels c l c'"
proof(atomize_elim)
  from l < #:c show "c'. labels c l c'"
  proof(induct c arbitrary:l)
    case Skip
    from l < #:Skip› have "l = 0" by simp
    thus ?case by(fastforce intro:Labels_Base)
  next
    case (LAss V e)
    from l < #:(V:=e) have "l = 0  l = 1" by auto
    thus ?case by(auto intro:Labels_Base Labels_LAss)
  next
    case (Seq c1 c2)
    note IH1 = l. l < #:c1  c'. labels c1 l c'
    note IH2 = l. l < #:c2  c'. labels c2 l c'
    show ?case
    proof(cases "l < #:c1")
      case True
      from IH1[OF this] obtain c' where "labels c1 l c'" by auto
      hence "labels (c1;;c2) l (c';;c2)" by(fastforce intro:Labels_Seq1)
      thus ?thesis by auto
    next
      case False
      hence "#:c1  l" by simp
      then obtain l' where "l = l' + #:c1" and "l' = l - #:c1" by simp
      from l = l' + #:c1 l < #:c1;;c2 have "l' < #:c2" by simp
      from IH2[OF this] obtain c' where "labels c2 l' c'" by auto
      with l = l' + #:c1 have "labels (c1;;c2) l c'" 
        by(fastforce intro:Labels_Seq2)
      thus ?thesis by auto
    qed
  next
    case (Cond b c1 c2)
    note IH1 = l. l < #:c1  c'. labels c1 l c'
    note IH2 = l. l < #:c2  c'. labels c2 l c'
    show ?case
    proof(cases "l = 0")
      case True
      thus ?thesis by(fastforce intro:Labels_Base)
    next
      case False
      hence "0 < l" by simp
      then obtain l' where "l = l' + 1" and "l' = l - 1" by simp
      thus ?thesis
      proof(cases "l' < #:c1")
        case True
        from IH1[OF this] obtain c' where "labels c1 l' c'" by auto
        with l = l' + 1 have "labels (if (b) c1 else c2) l c'"
          by(fastforce dest:Labels_CondTrue)
        thus ?thesis by auto
      next
        case False
        hence "#:c1  l'" by simp
        then obtain l'' where "l' = l'' + #:c1" and "l'' = l' - #:c1" by simp
        from l' = l'' + #:c1 l = l' + 1 l < #:if (b) c1 else c2
        have "l'' < #:c2" by simp
        from IH2[OF this] obtain c' where "labels c2 l'' c'" by auto
        with l' = l'' + #:c1 l = l' + 1 have "labels (if (b) c1 else c2) l c'"
          by(fastforce dest:Labels_CondFalse)
        thus ?thesis by auto
      qed
    qed
  next
    case (While b c')
    note IH = l. l < #:c'  c''. labels c' l c''
    show ?case
    proof(cases "l < 1")
      case True
      hence "l = 0" by simp
      thus ?thesis by(fastforce intro:Labels_Base)
    next
      case False
      show ?thesis
      proof(cases "l < 2")
        case True
        with ¬ l < 1 have "l = 1" by simp
        thus ?thesis by(fastforce intro:Labels_WhileExit)
      next
        case False
        with ¬ l < 1 have "2  l" by simp
        then obtain l' where "l = l' + 2" and "l' = l - 2" 
          by(simp del:add_2_eq_Suc')
        from l = l' + 2 l < #:while (b) c' have "l' < #:c'" by simp
        from IH[OF this] obtain c'' where "labels c' l' c''" by auto
        with l = l' + 2 have "labels (while (b) c') l (c'';;while (b) c')"
          by(fastforce dest:Labels_WhileBody)
        thus ?thesis by auto
      qed
    qed
  next
    case (Call p es rets)
    show ?case
    proof(cases "l < 1")
      case True
      hence "l = 0" by simp
      thus ?thesis by(fastforce intro:Labels_Base)
    next
      case False
      with l < #:Call p es rets have "l = 1" by simp
      thus ?thesis by(fastforce intro:Labels_Call)
    qed
  qed
qed


lemma labels_det:
  "labels c l c' (c''. labels c l c'' c' = c'')"
proof(induct rule:labels.induct)
  case (Labels_Base c c'') 
  from ‹labels c 0 c'' obtain l where "labels c l c''" and "l = 0" by auto
  thus ?case by(induct rule:labels.induct,auto)
next
  case (Labels_Seq1 c1 l c c2)
  note IH = c''. labels c1 l c''  c = c''
  from ‹labels c1 l c have "l < #:c1" by(fastforce intro:label_less_num_inner_nodes)
  with ‹labels (c1;;c2) l c'' obtain cx where "c'' = cx;;c2  labels c1 l cx"
    by(fastforce elim:labels.cases intro:Labels_Base)
  hence [simp]:"c'' = cx;;c2" and "labels c1 l cx" by simp_all
  from IH[OF ‹labels c1 l cx] show ?case by simp
next
  case (Labels_Seq2 c2 l c c1)
  note IH = c''. labels c2 l c''  c = c''
  from ‹labels (c1;;c2) (l + #:c1) c'' ‹labels c2 l c have "labels c2 l c''" 
    by(auto elim:labels.cases dest:label_less_num_inner_nodes)
  from IH[OF this] show ?case .
next
  case (Labels_CondTrue c1 l c b c2)
  note IH = c''. labels c1 l c''   c = c''
  from ‹labels (if (b) c1 else c2) (l + 1) c'' ‹labels c1 l c have "labels c1 l c''"
    by(fastforce elim:labels.cases dest:label_less_num_inner_nodes)
  from IH[OF this] show ?case .
next
  case (Labels_CondFalse c2 l c b c1)
  note IH = c''. labels c2 l c''   c = c''
  from ‹labels (if (b) c1 else c2) (l + #:c1 + 1) c'' ‹labels c2 l c
  have "labels c2 l c''"
    by(fastforce elim:labels.cases dest:label_less_num_inner_nodes)
  from IH[OF this] show ?case .
next
  case (Labels_WhileBody c' l c b)
  note IH = c''. labels c' l c''  c = c''
  from ‹labels (while (b) c') (l + 2) c'' ‹labels c' l c 
  obtain cx where "c'' = cx;;while (b) c'  labels c' l cx" 
    by -(erule labels.cases,auto)
  hence [simp]:"c'' = cx;;while (b) c'" and "labels c' l cx" by simp_all
  from IH[OF ‹labels c' l cx] show ?case by simp
qed (fastforce elim:labels.cases)+



definition label :: "cmd  nat  cmd"
  where "label c n  (THE c'. labels c n c')"


lemma labels_THE:
  "labels c l c'  (THE c'. labels c l c') = c'"
by(fastforce intro:the_equality dest:labels_det)


lemma labels_label:"labels c l c'  label c l = c'"
by(fastforce intro:labels_THE simp:label_def)


end

Theory WellFormed

section ‹Instantiate well-formedness locales with Proc CFG›

theory WellFormed imports Interpretation Labels "../StaticInter/CFGExit_wf" begin

subsection ‹Determining the first atomic command›

fun fst_cmd :: "cmd  cmd"
where "fst_cmd (c1;;c2) = fst_cmd c1"
  | "fst_cmd c = c"

lemma Proc_CFG_Call_target_fst_cmd_Skip:
  "labels prog l' c; prog  n -CEdge (p,es,rets)p Label l' 
   fst_cmd c = Skip"
proof(induct arbitrary:n rule:labels.induct) 
  case (Labels_Seq1 c1 l c c2)
  note IH = n. c1  n -CEdge (p, es, rets)p Label l  fst_cmd c = Skip›
  from c1;; c2  n -CEdge (p, es, rets)p Label l ‹labels c1 l c
  have "c1  n -CEdge (p, es, rets)p Label l"
    apply - apply(erule Proc_CFG.cases,auto dest:Proc_CFG_Call_Labels)
    by(case_tac n')(auto dest:label_less_num_inner_nodes)
  from IH[OF this] show ?case by simp
next
  case (Labels_Seq2 c2 l c c1)
  note IH = n. c2  n -CEdge (p, es, rets)p Label l  fst_cmd c = Skip›
  from c1;; c2  n -CEdge (p, es, rets)p Label (l + #:c1) ‹labels c2 l c
  obtain nx where "c2  nx -CEdge (p, es, rets)p Label l"
    apply - apply(erule Proc_CFG.cases)
    apply(auto dest:Proc_CFG_targetlabel_less_num_nodes Proc_CFG_Call_Labels)
    by(case_tac n') auto
  from IH[OF this] show ?case by simp
next
  case (Labels_CondTrue c1 l c b c2)
  note IH = n. c1  n -CEdge (p, es, rets)p Label l  fst_cmd c = Skip›
  from if (b) c1 else c2  n -CEdge (p, es, rets)p Label (l + 1) ‹labels c1 l c
  obtain nx where "c1  nx -CEdge (p, es, rets)p Label l"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(case_tac n') apply auto
    by(case_tac n')(auto dest:label_less_num_inner_nodes)
  from IH[OF this] show ?case by simp
next
  case (Labels_CondFalse c2 l c b c1)
  note IH = n. c2  n -CEdge (p, es, rets)p Label l  fst_cmd c = Skip›
  from if (b) c1 else c2  n -CEdge (p, es, rets)p Label (l + #:c1 + 1) 
    ‹labels c2 l c
  obtain nx where "c2  nx -CEdge (p, es, rets)p Label l"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(case_tac n') apply(auto dest:Proc_CFG_targetlabel_less_num_nodes)
    by(case_tac n') auto
  from IH[OF this] show ?case by simp
next
  case (Labels_WhileBody c' l c b)
  note IH = n. c'  n -CEdge (p, es, rets)p Label l  fst_cmd c = Skip›
  from while (b) c'  n -CEdge (p, es, rets)p Label (l + 2) ‹labels c' l c
  obtain nx where "c'  nx -CEdge (p, es, rets)p Label l"
    apply - apply(erule Proc_CFG.cases,auto)
    by(case_tac n') auto
  from IH[OF this] show ?case by simp
next
  case (Labels_Call px esx retsx)
  from ‹Call px esx retsx  n -CEdge (p, es, rets)p Label 1
  show ?case by(fastforce elim:Proc_CFG.cases)
qed(auto dest:Proc_CFG_Call_Labels)


lemma Proc_CFG_Call_source_fst_cmd_Call:
  "labels prog l c; prog  Label l -CEdge (p,es,rets)p n' 
   p es rets. fst_cmd c = Call p es rets"
proof(induct arbitrary:n' rule:labels.induct)
  case (Labels_Base c n')
  from c  Label 0 -CEdge (p, es, rets)p n' show ?case
    by(induct c "Label 0" "CEdge (p, es, rets)" n' rule:Proc_CFG.induct) auto
next
  case (Labels_LAss V e n')
  from V:=e  Label 1 -CEdge (p, es, rets)p n' show ?case
    by(fastforce elim:Proc_CFG.cases)
next
  case (Labels_Seq1 c1 l c c2)
  note IH = n'. c1  Label l -CEdge (p, es, rets)p n' 
     p es rets. fst_cmd c = Call p es rets
  from c1;; c2  Label l -CEdge (p, es, rets)p n' ‹labels c1 l c
  have "c1  Label l -CEdge (p, es, rets)p n'"
    apply - apply(erule Proc_CFG.cases,auto dest:Proc_CFG_Call_Labels)
    by(case_tac n)(auto dest:label_less_num_inner_nodes)
  from IH[OF this] show ?case by simp
next
  case (Labels_Seq2 c2 l c c1)
  note IH = n'. c2  Label l -CEdge (p, es, rets)p n'
     p es rets. fst_cmd c = Call p es rets
  from c1;; c2  Label (l + #:c1) -CEdge (p, es, rets)p n' ‹labels c2 l c
  obtain nx where "c2  Label l -CEdge (p, es, rets)p nx"
    apply - apply(erule Proc_CFG.cases)
    apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes Proc_CFG_Call_Labels)
    by(case_tac n) auto
  from IH[OF this] show ?case by simp
next
  case (Labels_CondTrue c1 l c b c2)
  note IH = n'. c1  Label l -CEdge (p, es, rets)p n' 
     p es rets. fst_cmd c = Call p es rets
  from if (b) c1 else c2  Label (l + 1) -CEdge (p, es, rets)p n' ‹labels c1 l c
  obtain nx where "c1  Label l -CEdge (p, es, rets)p nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(case_tac n) apply auto
    by(case_tac n)(auto dest:label_less_num_inner_nodes)
  from IH[OF this] show ?case by simp
next
  case (Labels_CondFalse c2 l c b c1)
  note IH = n'. c2  Label l -CEdge (p, es, rets)p n' 
     p es rets. fst_cmd c = Call p es rets
  from if (b) c1 else c2  Label  (l + #:c1 + 1)-CEdge (p, es, rets)p n' 
    ‹labels c2 l c
  obtain nx where "c2  Label l -CEdge (p, es, rets)p nx"
    apply - apply(erule Proc_CFG.cases,auto)
     apply(case_tac n) apply(auto dest:Proc_CFG_sourcelabel_less_num_nodes)
    by(case_tac n) auto
  from IH[OF this] show ?case by simp
next
  case (Labels_WhileBody c' l c b)
  note IH = n'. c'  Label l -CEdge (p, es, rets)p n' 
     p es rets. fst_cmd c = Call p es rets
  from while (b) c'  Label (l + 2) -CEdge (p, es, rets)p n' ‹labels c' l c
  obtain nx where "c'  Label l -CEdge (p, es, rets)p nx"
    apply - apply(erule Proc_CFG.cases,auto dest:Proc_CFG_Call_Labels)
    by(case_tac n) auto
  from IH[OF this] show ?case by simp
next
  case (Labels_WhileExit b c' n')
  have "while (b) c'  Label 1 -IEdge idp Exit" by(rule Proc_CFG_WhileFalseSkip)
  with while (b) c'  Label 1 -CEdge (p, es, rets)p n'
  have False by(rule Proc_CFG_Call_Intra_edge_not_same_source)
  thus ?case by simp
next
  case (Labels_Call px esx retsx)
  from ‹Call px esx retsx  Label 1 -CEdge (p, es, rets)p n'
  show ?case by(fastforce elim:Proc_CFG.cases)
qed


subsection ‹Definition of Def› and Use› sets›

subsubsection ParamDefs›

lemma PCFG_CallEdge_THE_rets:
  "prog  n -CEdge (p,es,rets)p n'
 (THE rets'. p' es' n. prog  n -CEdge(p',es',rets')p n') = rets"
by(fastforce intro:the_equality dest:Proc_CFG_Call_nodes_eq')


definition ParamDefs_proc :: "cmd  label  vname list"
  where "ParamDefs_proc c n  
  if (n' p' es' rets'. c  n' -CEdge(p',es',rets')p n) then 
     (THE rets'. p' es' n'. c  n' -CEdge(p',es',rets')p n)
  else []"


lemma in_procs_THE_in_procs_cmd:
  "well_formed procs; (p,ins,outs,c)  set procs
   (THE c'. ins' outs'. (p,ins',outs',c')  set procs) = c"
  by(fastforce intro:the_equality)


definition ParamDefs :: "wf_prog  node  vname list"
  where "ParamDefs wfp n  let (prog,procs) = Rep_wf_prog wfp; (p,l) = n in
  (if (p = Main) then ParamDefs_proc prog l
   else (if (ins outs c. (p,ins,outs,c)  set procs)
         then ParamDefs_proc (THE c'. ins' outs'. (p,ins',outs',c')  set procs) l
         else []))"


lemma ParamDefs_Main_Return_target:
  "Rep_wf_prog wfp = (prog,procs); prog  n -CEdge(p',es,rets)p n'
   ParamDefs wfp (Main,n') = rets"
  by(fastforce dest:PCFG_CallEdge_THE_rets simp:ParamDefs_def ParamDefs_proc_def)

lemma ParamDefs_Proc_Return_target:
  assumes "Rep_wf_prog wfp = (prog,procs)"
  and "(p,ins,outs,c)  set procs" and "c  n -CEdge(p',es,rets)p n'"
  shows "ParamDefs wfp (p,n') = rets"
proof -
  from ‹Rep_wf_prog wfp = (prog,procs) have "well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  with (p,ins,outs,c)  set procs have "p  Main" by fastforce
  moreover
  from ‹well_formed procs (p,ins,outs,c)  set procs
  have "(THE c'. ins' outs'. (p,ins',outs',c')  set procs) = c"
    by(rule in_procs_THE_in_procs_cmd)
  ultimately show ?thesis using assms
    by(fastforce dest:PCFG_CallEdge_THE_rets simp:ParamDefs_def ParamDefs_proc_def)
qed

lemma ParamDefs_Main_IEdge_Nil:
  "Rep_wf_prog wfp = (prog,procs); prog  n -IEdge etp n'
   ParamDefs wfp (Main,n') = []"
by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_target 
            simp:ParamDefs_def ParamDefs_proc_def)

lemma ParamDefs_Proc_IEdge_Nil:
  assumes "Rep_wf_prog wfp = (prog,procs)"
  and "(p,ins,outs,c)  set procs" and "c  n -IEdge etp n'"
  shows "ParamDefs wfp (p,n') = []"
proof -
  from ‹Rep_wf_prog wfp = (prog,procs) have "well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  with (p,ins,outs,c)  set procs have "p  Main" by fastforce  
  moreover
  from ‹well_formed procs (p,ins,outs,c)  set procs
  have "(THE c'. ins' outs'. (p,ins',outs',c')  set procs) = c"
    by(rule in_procs_THE_in_procs_cmd)
  ultimately show ?thesis using assms
    by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_target 
                simp:ParamDefs_def ParamDefs_proc_def)
qed

lemma ParamDefs_Main_CEdge_Nil:
  "Rep_wf_prog wfp = (prog,procs); prog  n' -CEdge(p',es,rets)p n''
   ParamDefs wfp (Main,n') = []"
by(fastforce dest:Proc_CFG_Call_targetnode_no_Call_sourcenode
            simp:ParamDefs_def ParamDefs_proc_def)

lemma ParamDefs_Proc_CEdge_Nil:
  assumes "Rep_wf_prog wfp = (prog,procs)"
  and "(p,ins,outs,c)  set procs" and "c  n' -CEdge(p',es,rets)p n''"
  shows "ParamDefs wfp (p,n') = []"
proof -
  from ‹Rep_wf_prog wfp = (prog,procs) have "well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  with (p,ins,outs,c)  set procs have "p  Main" by fastforce  
  moreover
  from ‹well_formed procs (p,ins,outs,c)  set procs
  have "(THE c'. ins' outs'. (p,ins',outs',c')  set procs) = c"
    by(rule in_procs_THE_in_procs_cmd)
  ultimately show ?thesis using assms
    by(fastforce dest:Proc_CFG_Call_targetnode_no_Call_sourcenode
                simp:ParamDefs_def ParamDefs_proc_def)
qed


lemma assumes "valid_edge wfp a" and "kind a = Q'pf'"
  and "(p, ins, outs)  set (lift_procs wfp)"
  shows ParamDefs_length:"length (ParamDefs wfp (targetnode a)) = length outs"
  (is ?length)
  and Return_update:"f' cf cf' = cf'(ParamDefs wfp (targetnode a) [:=] map cf outs)"
  (is ?update)
proof -
  from Rep_wf_prog[of wfp]
  obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)" 
    by(fastforce simp:wf_prog_def)
  hence "wf prog procs" by(rule wf_wf_prog)
  hence wf:"well_formed procs" by fastforce
  from assms have "prog,procs  sourcenode a -kind a targetnode a"
    by(simp add:valid_edge_def)
  from this ‹kind a = Q'pf' wf have "?length  ?update"
  proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
    case (MainReturn l p' es rets l' insx outsx cx)
    from λcf. snd cf = (Main, Label l')p'λcf cf'. cf'(rets [:=] map cf outsx) =
      kind a ‹kind a = Q'pf' have "p' = p" 
      and f':"f' = (λcf cf'. cf'(rets [:=] map cf outsx))" by simp_all
    with ‹well_formed procs (p', insx, outsx, cx)  set procs
      (p, ins, outs)  set (lift_procs wfp)
    have [simp]:"outsx = outs" by fastforce
    from prog  Label l -CEdge (p', es, rets)p Label l'
    have "containsCall procs prog [] p'" by(rule Proc_CFG_Call_containsCall)
    with ‹wf prog procs (p', insx, outsx, cx)  set procs 
      prog  Label l -CEdge (p', es, rets)p Label l'
    have "length rets = length outs" by fastforce
    from prog  Label l -CEdge (p', es, rets)p Label l'
    have "ParamDefs wfp (Main,Label l') = rets"
      by(fastforce intro:ParamDefs_Main_Return_target)
    with (Main, Label l') = targetnode a f' ‹length rets = length outs
    show ?thesis by simp
  next
    case (ProcReturn px insx outsx cx l p' es rets l' ins' outs' c' ps)
    from λcf. snd cf = (px, Label l')p'λcf cf'. cf'(rets [:=] map cf outs') =
      kind a ‹kind a = Q'pf'
    have "p' = p" and f':"f' = (λcf cf'. cf'(rets [:=] map cf outs'))"
      by simp_all
    with ‹well_formed procs (p', ins', outs', c')  set procs
      (p, ins, outs)  set (lift_procs wfp)
    have [simp]:"outs' = outs" by fastforce
    from cx  Label l -CEdge (p', es, rets)p Label l'
    have "containsCall procs cx [] p'" by(rule Proc_CFG_Call_containsCall)
    with ‹containsCall procs prog ps px (px, insx, outsx, cx)  set procs
    have "containsCall procs prog (ps@[px]) p'" by(rule containsCall_in_proc)
    with ‹wf prog procs (p', ins', outs', c')  set procs
      cx  Label l -CEdge (p', es, rets)p Label l'
    have "length rets = length outs" by fastforce
    from (px, insx, outsx, cx)  set procs
      cx  Label l -CEdge (p', es, rets)p Label l'
    have "ParamDefs wfp (px,Label l') = rets"
      by(fastforce intro:ParamDefs_Proc_Return_target simp:set_conv_nth)
    with (px, Label l') = targetnode a f' ‹length rets = length outs
    show ?thesis by simp
  qed auto
  thus "?length" and "?update" by simp_all
qed


subsubsection ParamUses›

fun fv :: "expr  vname set"
where
  "fv (Val v)       = {}"
  | "fv (Var V)       = {V}"
  | "fv (e1 «bop» e2) = (fv e1  fv e2)"


lemma rhs_interpret_eq: 
  "state_check cf e v'; V  fv e. cf V = cf' V 
    state_check cf' e v'"
proof(induct e arbitrary:v')
  case (Val v)
  from ‹state_check cf (Val v) v' have "v' = Some v" 
    by(fastforce elim:interpret.cases)
  thus ?case by simp
next
  case (Var V)
  hence "cf' (V) = v'" by(fastforce elim:interpret.cases)
  thus ?case by simp
next
  case (BinOp b1 bop b2)
  note IH1 = v'. state_check cf b1 v'; Vfv b1. cf V = cf' V
     state_check cf' b1 v'
  note IH2 = v'. state_check cf b2 v'; Vfv b2. cf V = cf' V
     state_check cf' b2 v'
  from V  fv (b1 «bop» b2). cf V = cf' V have "V  fv b1. cf V = cf' V"
    and "V  fv b2. cf V = cf' V" by simp_all
  from ‹state_check cf (b1 «bop» b2) v'
  have "((state_check cf b1 None  v' = None)  
          (state_check cf b2 None  v' = None)) 
    (v1 v2. state_check cf b1 (Some v1)  state_check cf b2 (Some v2) 
    binop bop v1 v2 = v')"
    apply(cases "interpret b1 cf",simp)
    apply(cases "interpret b2 cf",simp)
    by(case_tac "binop bop a aa",simp+)
  thus ?case apply - 
  proof(erule disjE)+
    assume "state_check cf b1 None  v' = None"
    hence check:"state_check cf b1 None" and "v' = None" by simp_all
    from IH1[OF check V  fv b1. cf V = cf' V] have "state_check cf' b1 None" .
    with v' = None› show ?case by simp
  next
    assume "state_check cf b2 None  v' = None"
    hence check:"state_check cf b2 None" and "v' = None" by simp_all
    from IH2[OF check V  fv b2. cf V = cf' V] have "state_check cf' b2 None" .
    with v' = None› show ?case by(cases "interpret b1 cf'") simp+
  next
    assume "v1 v2. state_check cf b1 (Some v1) 
      state_check cf b2 (Some v2)  binop bop v1 v2 = v'"
    then obtain v1 v2 where "state_check cf b1 (Some v1)"
      and "state_check cf b2 (Some v2)" and "binop bop v1 v2 = v'" by blast
    from V  fv (b1 «bop» b2). cf V = cf' V have "V  fv b1. cf V = cf' V"
      by simp
    from IH1[OF ‹state_check cf b1 (Some v1) this]
    have "interpret b1 cf' = Some v1" .
    from V  fv (b1 «bop» b2). cf V = cf' V have "V  fv b2. cf V = cf' V"
      by simp
    from IH2[OF ‹state_check cf b2 (Some v2) this] 
    have "interpret b2 cf' = Some v2" .
    with ‹interpret b1 cf' = Some v1 ‹binop bop v1 v2 = v'
    show ?thesis by(cases v') simp+
  qed
qed



lemma PCFG_CallEdge_THE_es:
  "prog  n -CEdge(p,es,rets)p n'
 (THE es'. p' rets' n'. prog  n -CEdge(p',es',rets')p n') = es"
by(fastforce intro:the_equality dest:Proc_CFG_Call_nodes_eq)


definition ParamUses_proc :: "cmd  label  vname set list"
  where "ParamUses_proc c n 
  if (n' p' es' rets'. c  n -CEdge(p',es',rets')p n') then 
  (map fv (THE es'. p' rets' n'. c  n -CEdge(p',es',rets')p n'))
  else []"


definition ParamUses :: "wf_prog  node  vname set list"
  where "ParamUses wfp n  let (prog,procs) = Rep_wf_prog wfp; (p,l) = n in
  (if (p = Main) then ParamUses_proc prog l
   else (if (ins outs c. (p,ins,outs,c)  set procs)
         then ParamUses_proc (THE c'. ins' outs'. (p,ins',outs',c')  set procs) l
         else []))"


lemma ParamUses_Main_Return_target:
  "Rep_wf_prog wfp = (prog,procs); prog  n -CEdge(p',es,rets)p n' 
   ParamUses wfp (Main,n) = map fv es"
  by(fastforce dest:PCFG_CallEdge_THE_es simp:ParamUses_def ParamUses_proc_def)

lemma ParamUses_Proc_Return_target:
  assumes "Rep_wf_prog wfp = (prog,procs)"
  and "(p,ins,outs,c)  set procs" and "c  n -CEdge(p',es,rets)p n'"
  shows "ParamUses wfp (p,n) = map fv es"
proof -
  from ‹Rep_wf_prog wfp = (prog,procs) have "well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  with (p,ins,outs,c)  set procs have "p  Main" by fastforce  
  moreover
  from ‹well_formed procs (p,ins,outs,c)  set procs
  have "(THE c'. ins' outs'. (p,ins',outs',c')  set procs) = c"
    by(rule in_procs_THE_in_procs_cmd)
  ultimately show ?thesis using assms
    by(fastforce dest:PCFG_CallEdge_THE_es simp:ParamUses_def ParamUses_proc_def)
qed

lemma ParamUses_Main_IEdge_Nil:
  "Rep_wf_prog wfp = (prog,procs); prog  n -IEdge etp n'
   ParamUses wfp (Main,n) = []"
by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_source
            simp:ParamUses_def ParamUses_proc_def)

lemma ParamUses_Proc_IEdge_Nil:
  assumes "Rep_wf_prog wfp = (prog,procs)"
  and "(p,ins,outs,c)  set procs" and "c  n -IEdge etp n'"
  shows "ParamUses wfp (p,n) = []"
proof -
  from ‹Rep_wf_prog wfp = (prog,procs) have "well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  with (p,ins,outs,c)  set procs have "p  Main" by fastforce  
  moreover
  from ‹well_formed procs (p,ins,outs,c)  set procs
  have "(THE c'. ins' outs'. (p,ins',outs',c')  set procs) = c"
    by(rule in_procs_THE_in_procs_cmd)
  ultimately show ?thesis using assms
    by(fastforce dest:Proc_CFG_Call_Intra_edge_not_same_source
                simp:ParamUses_def ParamUses_proc_def)
qed

lemma ParamUses_Main_CEdge_Nil:
  "Rep_wf_prog wfp = (prog,procs); prog  n' -CEdge(p',es,rets)p n
   ParamUses wfp (Main,n) = []"
by(fastforce dest:Proc_CFG_Call_targetnode_no_Call_sourcenode
            simp:ParamUses_def ParamUses_proc_def)

lemma ParamUses_Proc_CEdge_Nil:
  assumes "Rep_wf_prog wfp = (prog,procs)"
  and "(p,ins,outs,c)  set procs" and "c  n' -CEdge(p',es,rets)p n"
  shows "ParamUses wfp (p,n) = []"
proof -
  from ‹Rep_wf_prog wfp = (prog,procs) have "well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  with (p,ins,outs,c)  set procs have "p  Main" by fastforce  
  moreover
  from ‹well_formed procs 
    (p,ins,outs,c)  set procs
  have "(THE c'. ins' outs'. (p,ins',outs',c')  set procs) = c"
    by(rule in_procs_THE_in_procs_cmd)
  ultimately show ?thesis using assms
    by(fastforce dest:Proc_CFG_Call_targetnode_no_Call_sourcenode
                simp:ParamUses_def ParamUses_proc_def)
qed


subsubsection Def›

fun lhs :: "cmd  vname set"
where
  "lhs Skip                = {}"
  | "lhs (V:=e)              = {V}"
  | "lhs (c1;;c2)            = lhs c1"
  | "lhs (if (b) c1 else c2) = {}"
  | "lhs (while (b) c)       = {}"
  | "lhs (Call p es rets)    = {}"

lemma lhs_fst_cmd:"lhs (fst_cmd c) = lhs c" by(induct c) auto

lemma Proc_CFG_Call_source_empty_lhs:
  assumes "prog  Label l -CEdge (p,es,rets)p n'"
  shows "lhs (label prog l) = {}"
proof -
  from prog  Label l -CEdge (p,es,rets)p n' have "l < #:prog"
    by(rule Proc_CFG_sourcelabel_less_num_nodes)
  then obtain c' where "labels prog l c'"
    by(erule less_num_inner_nodes_label)
  hence "label prog l = c'" by(rule labels_label)
  from ‹labels prog l c' prog  Label l -CEdge (p,es,rets)p n'
  have "p es rets. fst_cmd c' = Call p es rets" 
    by(rule Proc_CFG_Call_source_fst_cmd_Call)
  with lhs_fst_cmd[of c'] have "lhs c' = {}" by auto
  with ‹label prog l = c' show ?thesis by simp
qed


lemma in_procs_THE_in_procs_ins:
  "well_formed procs; (p,ins,outs,c)  set procs
   (THE ins'. c' outs'. (p,ins',outs',c')  set procs) = ins"
  by(fastforce intro:the_equality)


definition Def :: "wf_prog  node  vname set"
  where "Def wfp n  (let (prog,procs) = Rep_wf_prog wfp; (p,l) = n in
  (case l of Label lx  
    (if p = Main then lhs (label prog lx)
     else (if (ins outs c. (p,ins,outs,c)  set procs)
           then 
  lhs (label (THE c'. ins' outs'. (p,ins',outs',c')  set procs) lx)
           else {}))
  | Entry  if (ins outs c. (p,ins,outs,c)  set procs)
            then (set 
      (THE ins'. c' outs'. (p,ins',outs',c')  set procs)) else {}
  | Exit  {}))
     set (ParamDefs wfp n)"

lemma Entry_Def_empty:"Def wfp (Main, Entry) = {}"
proof -
  obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
    by(cases "Rep_wf_prog wfp") auto
  hence "well_formed procs" by(fastforce intro:wf_wf_prog)
  thus ?thesis by(auto simp:Def_def ParamDefs_def ParamDefs_proc_def)
qed


lemma Exit_Def_empty:"Def wfp (Main, Exit) = {}"
  proof -
  obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
    by(cases "Rep_wf_prog wfp") auto
  hence "well_formed procs" by(fastforce intro:wf_wf_prog)
  thus ?thesis 
    by(auto dest:Proc_CFG_Call_Labels simp:Def_def ParamDefs_def ParamDefs_proc_def)
qed



subsubsection Use›

fun rhs :: "cmd  vname set"
where
  "rhs Skip                = {}"
  | "rhs (V:=e)              = fv e"
  | "rhs (c1;;c2)            = rhs c1"
  | "rhs (if (b) c1 else c2) = fv b"
  | "rhs (while (b) c)       = fv b"
  | "rhs (Call p es rets)    = {}"

lemma rhs_fst_cmd:"rhs (fst_cmd c) = rhs c" by(induct c) auto

lemma Proc_CFG_Call_target_empty_rhs:
  assumes "prog  n -CEdge (p,es,rets)p Label l'"
  shows "rhs (label prog l') = {}"
proof -
  from prog  n -CEdge (p,es,rets)p Label l' have "l' < #:prog"
    by(rule Proc_CFG_targetlabel_less_num_nodes)
  then obtain c' where "labels prog l' c'"
    by(erule less_num_inner_nodes_label)
  hence "label prog l' = c'" by(rule labels_label)
  from ‹labels prog l' c' prog  n -CEdge (p,es,rets)p Label l'
  have "fst_cmd c' = Skip" by(rule Proc_CFG_Call_target_fst_cmd_Skip)
  with rhs_fst_cmd[of c'] have "rhs c' = {}" by simp
  with ‹label prog l' = c' show ?thesis by simp
qed



lemma in_procs_THE_in_procs_outs:
  "well_formed procs; (p,ins,outs,c)  set procs
   (THE outs'. c' ins'. (p,ins',outs',c')  set procs) = outs"
  by(fastforce intro:the_equality)


definition Use :: "wf_prog  node  vname set"
  where "Use wfp n  (let (prog,procs) = Rep_wf_prog wfp; (p,l) = n in
  (case l of Label lx  
    (if p = Main then rhs (label prog lx) 
     else (if (ins outs c. (p,ins,outs,c)  set procs)
           then 
  rhs (label (THE c'. ins' outs'. (p,ins',outs',c')  set procs) lx)
           else {}))
  | Exit  if (ins outs c. (p,ins,outs,c)  set procs)
            then (set (THE outs'. c' ins'. (p,ins',outs',c')  set procs) )
            else {}
  | Entry  if (ins outs c. (p,ins,outs,c)  set procs)
      then (set (THE ins'. c' outs'. (p,ins',outs',c')  set procs))
      else {}))
   Union (set (ParamUses wfp n))  set (ParamDefs wfp n)"


lemma Entry_Use_empty:"Use wfp (Main, Entry) = {}"
proof -
  obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
    by(cases "Rep_wf_prog wfp") auto
  hence "well_formed procs" by(fastforce intro:wf_wf_prog)
  thus ?thesis by(auto dest:Proc_CFG_Call_Labels 
    simp:Use_def ParamUses_def ParamUses_proc_def ParamDefs_def ParamDefs_proc_def)
qed

lemma Exit_Use_empty:"Use wfp (Main, Exit) = {}"
proof -
  obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)"
    by(cases "Rep_wf_prog wfp") auto
  hence "well_formed procs" by(fastforce intro:wf_wf_prog)
  thus ?thesis by(auto dest:Proc_CFG_Call_Labels 
    simp:Use_def ParamUses_def ParamUses_proc_def ParamDefs_def ParamDefs_proc_def)
qed


subsection ‹Lemmas about edges and call frames›

lemmas transfers_simps = ProcCFG.transfer.simps[simplified]
declare transfers_simps [simp]

abbreviation state_val :: "(('var  'val) × 'ret) list  'var  'val"
  where "state_val s V  (fst (hd s)) V"

lemma Proc_CFG_edge_no_lhs_equal:
  assumes "prog  Label l -IEdge etp n'" and "V  lhs (label prog l)"
  shows "state_val (CFG.transfer (lift_procs wfp) et (cf#cfs)) V = fst cf V"
proof -
  from prog  Label l -IEdge etp n' 
  obtain x where "IEdge et = x" and "prog  Label l -xp n'" by simp_all
  from prog  Label l -xp n' ‹IEdge et = x V  lhs (label prog l)
  show ?thesis
  proof(induct prog "Label l" x n' arbitrary:l rule:Proc_CFG.induct)
    case (Proc_CFG_LAss V' e)
    have "labels (V':=e) 0 (V':=e)" by(rule Labels_Base)
    hence "label (V':=e) 0 = (V':=e)" by(rule labels_label)
    have "V'  lhs (V':=e)" by simp
    with V  lhs (label (V':=e) 0)
      ‹IEdge et = IEdge λcf. update cf V' e ‹label (V':=e) 0 = (V':=e)
    show ?case by fastforce
  next
    case (Proc_CFG_SeqFirst c1 et' n' c2)
    note IH = IEdge et = et'; V  lhs (label c1 l)
       state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V
    from c1  Label l -et'p n' have "l < #:c1"
      by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c1 l c'" by(erule less_num_inner_nodes_label)
    hence "labels (c1;;c2) l (c';;c2)" by(rule Labels_Seq1)
    hence "label (c1;;c2) l = c';;c2" by(rule labels_label)
    with V  lhs (label (c1;; c2) l) ‹labels c1 l c' 
    have "V  lhs (label c1 l)" by(fastforce dest:labels_label)
    with ‹IEdge et = et' show ?case by (rule IH)
  next
    case (Proc_CFG_SeqConnect c1 et' c2)
    note IH = IEdge et = et'; V  lhs (label c1 l)
       state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V
    from c1  Label l -et'p Exit› have "l < #:c1"
      by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c1 l c'" by(erule less_num_inner_nodes_label)
    hence "labels (c1;;c2) l (c';;c2)" by(rule Labels_Seq1)
    hence "label (c1;;c2) l = c';;c2" by(rule labels_label)
    with V  lhs (label (c1;; c2) l) ‹labels c1 l c' 
    have "V  lhs (label c1 l)" by(fastforce dest:labels_label)
    with ‹IEdge et = et' show ?case by (rule IH)
  next
    case (Proc_CFG_SeqSecond c2 n et' n' c1 l)
    note IH = l. n = Label l; IEdge et = et'; V  lhs (label c2 l)
       state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V
    from n  #:c1 = Label l obtain l' 
      where "n = Label l'" and "l = l' + #:c1" by(cases n) auto
    from n = Label l' c2  n -et'p n' have "l' < #:c2"
      by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c2 l' c'" by(erule less_num_inner_nodes_label)
    with l = l' + #:c1 have "labels (c1;;c2) l c'" 
      by(fastforce intro:Labels_Seq2)
    hence "label (c1;;c2) l = c'" by(rule labels_label)
    with V  lhs (label (c1;;c2) l) ‹labels c2 l' c' l = l' + #:c1
    have "V  lhs (label c2 l')" by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et' show ?case by (rule IH)
  next
    case (Proc_CFG_CondThen c1 n et' n' b c2 l)
    note IH = l. n = Label l; IEdge et = et'; V  lhs (label c1 l)
       state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V
    from n  1 = Label l obtain l' 
      where "n = Label l'" and "l = l' + 1" by(cases n) auto
    from n = Label l' c1  n -et'p n' have "l' < #:c1"
      by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c1 l' c'" by(erule less_num_inner_nodes_label)
    with l = l' + 1 have "labels (if (b) c1 else c2) l c'" 
      by(fastforce intro:Labels_CondTrue)
    hence "label (if (b) c1 else c2) l = c'" by(rule labels_label)
    with V  lhs (label (if (b) c1 else c2) l) ‹labels c1 l' c' l = l' + 1
    have "V  lhs (label c1 l')" by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et' show ?case by (rule IH)
  next
    case (Proc_CFG_CondElse c2 n et' n' b c1 l)
    note IH = l. n = Label l; IEdge et = et'; V  lhs (label c2 l)
       state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V
    from n  #:c1 + 1 = Label l obtain l' 
      where "n = Label l'" and "l = l' + #:c1 + 1" by(cases n) auto
    from n = Label l' c2  n -et'p n' have "l' < #:c2"
      by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c2 l' c'" by(erule less_num_inner_nodes_label)
    with l = l' + #:c1 + 1 have "labels (if (b) c1 else c2) l c'" 
      by(fastforce intro:Labels_CondFalse)
    hence "label (if (b) c1 else c2) l = c'" by(rule labels_label)
    with V  lhs (label (if (b) c1 else c2) l) ‹labels c2 l' c' l = l' + #:c1 + 1
    have "V  lhs (label c2 l')" by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et' show ?case by (rule IH)
  next
    case (Proc_CFG_WhileBody c' n et' n' b l)
    note IH = l. n = Label l; IEdge et = et'; V  lhs (label c' l)
       state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V
    from n  2 = Label l obtain l' 
      where "n = Label l'" and "l = l' + 2" by(cases n) auto
    from n = Label l' c'  n -et'p n' have "l' < #:c'"
      by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain cx where "labels c' l' cx" by(erule less_num_inner_nodes_label)
    with l = l' + 2 have "labels (while (b) c') l (cx;;while (b) c')" 
      by(fastforce intro:Labels_WhileBody)
    hence "label (while (b) c') l = cx;;while (b) c'" by(rule labels_label)
    with V  lhs (label (while (b) c') l) ‹labels c' l' cx l = l' + 2
    have "V  lhs (label c' l')" by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et' show ?case by (rule IH)
  next
    case (Proc_CFG_WhileBodyExit c' n et' b l)
    note IH = l. n = Label l; IEdge et = et'; V  lhs (label c' l)
       state_val (CFG.transfer (lift_procs wfp) et (cf # cfs)) V = fst cf V
    from n  2 = Label l obtain l' 
      where "n = Label l'" and "l = l' + 2" by(cases n) auto
    from n = Label l' c'  n -et'p Exit› have "l' < #:c'"
      by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain cx where "labels c' l' cx" by(erule less_num_inner_nodes_label)
    with l = l' + 2 have "labels (while (b) c') l (cx;;while (b) c')" 
      by(fastforce intro:Labels_WhileBody)
    hence "label (while (b) c') l = cx;;while (b) c'" by(rule labels_label)
    with V  lhs (label (while (b) c') l) ‹labels c' l' cx l = l' + 2
    have "V  lhs (label c' l')" by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et' show ?case by (rule IH)
  qed auto
qed



lemma Proc_CFG_edge_uses_only_rhs:
  assumes "prog  Label l -IEdge etp n'" and "CFG.pred et s"
  and "CFG.pred et s'" and "Vrhs (label prog l). state_val s V = state_val s' V"
  shows "Vlhs (label prog l). 
    state_val (CFG.transfer (lift_procs wfp) et s) V =
    state_val (CFG.transfer (lift_procs wfp) et s') V"
proof -
  from prog  Label l -IEdge etp n' 
  obtain x where "IEdge et = x" and "prog  Label l -xp n'" by simp_all
  from ‹CFG.pred et s obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
  from ‹CFG.pred et s' obtain cf' cfs' where [simp]:"s' = cf'#cfs'" 
    by(cases s') auto
  from prog  Label l -xp n' ‹IEdge et = x
    Vrhs (label prog l). state_val s V = state_val s' V
  show ?thesis
  proof(induct prog "Label l" x n' arbitrary:l rule:Proc_CFG.induct)
    case Proc_CFG_Skip
    have "labels Skip 0 Skip" by(rule Labels_Base)
    hence "label Skip 0 = Skip" by(rule labels_label)
    hence "V. V  lhs (label Skip 0)" by simp
    then show ?case by fastforce
  next
    case (Proc_CFG_LAss V e)
    have "labels (V:=e) 0 (V:=e)" by(rule Labels_Base)
    hence "label (V:=e) 0 = V:=e" by(rule labels_label)
    then have "lhs (label (V:=e) 0) = {V}"
      and "rhs (label (V:=e) 0) = fv e" by auto
    with ‹IEdge et = IEdge λcf. update cf V e 
      Vrhs (label (V:=e) 0). state_val s V = state_val s' V
    show ?case by(fastforce intro:rhs_interpret_eq)
  next
    case (Proc_CFG_LAssSkip V e)
    have "labels (V:=e) 1 Skip" by(rule Labels_LAss)
    hence "label (V:=e) 1 = Skip" by(rule labels_label)
    hence "V'. V'  lhs (label (V:=e) 1)" by simp
    then show ?case by fastforce
  next
    case (Proc_CFG_SeqFirst c1 et' n' c2)
    note IH = IEdge et = et'; 
      Vrhs (label c1 l). state_val s V = state_val s' V
       Vlhs (label c1 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
        state_val (CFG.transfer (lift_procs wfp) et s') V
    from c1  Label l -et'p n'
    have "l < #:c1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c1 l c'" by(erule less_num_inner_nodes_label)
    hence "labels (c1;;c2) l (c';;c2)" by(rule Labels_Seq1)
    with ‹labels c1 l c' Vrhs (label (c1;; c2) l). state_val s V = state_val s' V
    have "Vrhs (label c1 l). state_val s V = state_val s' V"
      by(fastforce dest:labels_label)
    with ‹IEdge et = et'
    have "Vlhs (label c1 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
      state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
    with ‹labels c1 l c' ‹labels (c1;;c2) l (c';;c2)
    show ?case by(fastforce dest:labels_label)
  next
    case (Proc_CFG_SeqConnect c1 et' c2)
    note IH = IEdge et = et'; 
      Vrhs (label c1 l). state_val s V = state_val s' V
       Vlhs (label c1 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
        state_val (CFG.transfer (lift_procs wfp) et s') V
    from c1  Label l -et'p Exit›
    have "l < #:c1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c1 l c'" by(erule less_num_inner_nodes_label)
    hence "labels (c1;;c2) l (c';;c2)" by(rule Labels_Seq1)
    with ‹labels c1 l c' Vrhs (label (c1;; c2) l). state_val s V = state_val s' V
    have "Vrhs (label c1 l). state_val s V = state_val s' V"
      by(fastforce dest:labels_label)
    with ‹IEdge et = et'
    have "Vlhs (label c1 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
      state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
    with ‹labels c1 l c' ‹labels (c1;;c2) l (c';;c2)
    show ?case by(fastforce dest:labels_label)
  next
    case (Proc_CFG_SeqSecond c2 n et' n' c1)
    note IH = l. n = Label l; IEdge et = et'; 
      Vrhs (label c2 l). state_val s V = state_val s' V
       Vlhs (label c2 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
        state_val (CFG.transfer (lift_procs wfp) et s') V
    from n  #:c1 = Label l obtain l' where "n = Label l'" and "l = l' + #:c1"
      by(cases n) auto
    from c2  n -et'p n' n = Label l'
    have "l' < #:c2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c2 l' c'" by(erule less_num_inner_nodes_label)
    with l = l' + #:c1 have "labels (c1;;c2) l c'" by(fastforce intro:Labels_Seq2)
    with ‹labels c2 l' c' Vrhs (label (c1;;c2) l). state_val s V = state_val s' V
    have "Vrhs (label c2 l'). state_val s V = state_val s' V"
      by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et'
    have "Vlhs (label c2 l'). state_val (CFG.transfer (lift_procs wfp) et s) V =
      state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
    with ‹labels c2 l' c' ‹labels (c1;;c2) l c'
    show ?case by(fastforce dest:labels_label)
  next
    case (Proc_CFG_CondTrue b c1 c2)
    have "labels (if (b) c1 else c2) 0 (if (b) c1 else c2)" by(rule Labels_Base)
    hence "label (if (b) c1 else c2) 0 = if (b) c1 else c2" by(rule labels_label)
    hence "V. V  lhs (label (if (b) c1 else c2) 0)" by simp
    then show ?case by fastforce
  next
    case (Proc_CFG_CondFalse b c1 c2)
    have "labels (if (b) c1 else c2) 0 (if (b) c1 else c2)" by(rule Labels_Base)
    hence "label (if (b) c1 else c2) 0 = if (b) c1 else c2" by(rule labels_label)
    hence "V. V  lhs (label (if (b) c1 else c2) 0)" by simp
    then show ?case by fastforce
  next
    case (Proc_CFG_CondThen c1 n et' n' b c2)
    note IH = l. n = Label l; IEdge et = et'; 
      Vrhs (label c1 l). state_val s V = state_val s' V
       Vlhs (label c1 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
        state_val (CFG.transfer (lift_procs wfp) et s') V
    from n  1 = Label l obtain l' where "n = Label l'" and "l = l' + 1"
      by(cases n) auto
    from c1  n -et'p n' n = Label l'
    have "l' < #:c1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c1 l' c'" by(erule less_num_inner_nodes_label)
    with l = l' + 1 have "labels (if (b) c1 else c2) l c'" 
      by(fastforce intro:Labels_CondTrue)
    with ‹labels c1 l' c' Vrhs (label (if (b) c1 else c2) l). state_val s V = state_val s' V
    have "Vrhs (label c1 l'). state_val s V = state_val s' V"
      by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et'
    have "Vlhs (label c1 l'). state_val (CFG.transfer (lift_procs wfp) et s) V =
      state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
    with ‹labels c1 l' c' ‹labels (if (b) c1 else c2) l c'
    show ?case by(fastforce dest:labels_label)
  next
    case (Proc_CFG_CondElse c2 n et' n' b c1)
    note IH = l. n = Label l; IEdge et = et';
      Vrhs (label c2 l). state_val s V = state_val s' V
       Vlhs (label c2 l). state_val (CFG.transfer (lift_procs wfp) et s) V =
        state_val (CFG.transfer (lift_procs wfp) et s') V
    from n  #:c1 + 1= Label l obtain l' where "n = Label l'" and "l = l' + #:c1+1"
      by(cases n) auto
    from c2  n -et'p n' n = Label l'
    have "l' < #:c2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c2 l' c'" by(erule less_num_inner_nodes_label)
    with l = l' + #:c1 + 1 have "labels (if (b) c1 else c2) l c'" 
      by(fastforce intro:Labels_CondFalse)
    with ‹labels c2 l' c' Vrhs (label (if (b) c1 else c2) l). 
      state_val s V = state_val s' V
    have "Vrhs (label c2 l'). state_val s V = state_val s' V"
      by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et'
    have "Vlhs (label c2 l'). state_val (CFG.transfer (lift_procs wfp) et s) V =
      state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
    with ‹labels c2 l' c' ‹labels (if (b) c1 else c2) l c'
    show ?case by(fastforce dest:labels_label)
  next
    case (Proc_CFG_WhileTrue b c')
    have "labels (while (b) c') 0 (while (b) c')" by(rule Labels_Base)
    hence "label (while (b) c') 0 = while (b) c'" by(rule labels_label)
    hence "V. V  lhs (label (while (b) c') 0)" by simp
    then show ?case by fastforce
  next
    case (Proc_CFG_WhileFalse b c')
    have "labels (while (b) c') 0 (while (b) c')" by(rule Labels_Base)
    hence "label (while (b) c') 0 = while (b) c'" by(rule labels_label)
    hence "V. V  lhs (label (while (b) c') 0)" by simp
    then show ?case by fastforce
  next
    case (Proc_CFG_WhileFalseSkip b c')
    have "labels (while (b) c') 1 Skip" by(rule Labels_WhileExit)
    hence "label (while (b) c') 1 = Skip" by(rule labels_label)
    hence "V. V  lhs (label (while (b) c') 1)" by simp
    then show ?case by fastforce
  next
    case (Proc_CFG_WhileBody c' n et' n' b)
    note IH = l. n = Label l; IEdge et = et';
      Vrhs (label c' l). state_val s V = state_val s' V
       Vlhs (label c' l). state_val (CFG.transfer (lift_procs wfp) et s) V =
        state_val (CFG.transfer (lift_procs wfp) et s') V
    from n  2 = Label l obtain l' where "n = Label l'" and "l = l' + 2"
      by(cases n) auto
    from c'  n -et'p n' n = Label l'
    have "l' < #:c'" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain cx where "labels c' l' cx" by(erule less_num_inner_nodes_label)
    with l = l' + 2 have "labels (while (b) c') l (cx;;while (b) c')" 
      by(fastforce intro:Labels_WhileBody)
    with ‹labels c' l' cx Vrhs (label (while (b) c') l). 
      state_val s V = state_val s' V
    have "Vrhs (label c' l'). state_val s V = state_val s' V"
      by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et'
    have "Vlhs (label c' l'). state_val (CFG.transfer (lift_procs wfp) et s) V =
      state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
    with ‹labels c' l' cx ‹labels (while (b) c') l (cx;;while (b) c')
    show ?case by(fastforce dest:labels_label)
  next
    case (Proc_CFG_WhileBodyExit c' n et' b)
    note IH = l. n = Label l; IEdge et = et';
      Vrhs (label c' l). state_val s V = state_val s' V
       Vlhs (label c' l). state_val (CFG.transfer (lift_procs wfp) et s) V =
        state_val (CFG.transfer (lift_procs wfp) et s') V
    from n  2 = Label l obtain l' where "n = Label l'" and "l = l' + 2"
      by(cases n) auto
    from c'  n -et'p Exit› n = Label l'
    have "l' < #:c'" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain cx where "labels c' l' cx" by(erule less_num_inner_nodes_label)
    with l = l' + 2 have "labels (while (b) c') l (cx;;while (b) c')" 
      by(fastforce intro:Labels_WhileBody)
    with ‹labels c' l' cx Vrhs (label (while (b) c') l).
      state_val s V = state_val s' V
    have "Vrhs (label c' l'). state_val s V = state_val s' V"
      by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et'
    have "Vlhs (label c' l'). state_val (CFG.transfer (lift_procs wfp) et s) V =
      state_val (CFG.transfer (lift_procs wfp) et s') V" by (rule IH)
    with ‹labels c' l' cx ‹labels (while (b) c') l (cx;;while (b) c')
    show ?case by(fastforce dest:labels_label)
  next
    case (Proc_CFG_CallSkip p es rets)
    have "labels (Call p es rets) 1 Skip" by(rule Labels_Call)
    hence "label (Call p es rets) 1 = Skip" by(rule labels_label)
    hence "V. V  lhs (label (Call p es rets) 1)" by simp
    then show ?case by fastforce
  qed auto
qed


lemma Proc_CFG_edge_rhs_pred_eq:
  assumes "prog  Label l -IEdge etp n'" and "CFG.pred et s"
  and "Vrhs (label prog l). state_val s V = state_val s' V"
  and "length s = length s'"
  shows "CFG.pred et s'"
proof -
  from prog  Label l -IEdge etp n' 
  obtain x where "IEdge et = x" and "prog  Label l -xp n'" by simp_all
  from ‹CFG.pred et s obtain cf cfs where [simp]:"s = cf#cfs" by(cases s) auto
  from ‹length s = length s' obtain cf' cfs' where [simp]:"s' = cf'#cfs'" 
    by(cases s') auto
  from prog  Label l -xp n' ‹IEdge et = x 
    Vrhs (label prog l). state_val s V = state_val s' V
  show ?thesis
  proof(induct prog "Label l" x n' arbitrary:l rule:Proc_CFG.induct)
    case (Proc_CFG_SeqFirst c1 et' n' c2)
    note IH = IEdge et = et'; Vrhs (label c1 l). 
      state_val s V = state_val s' V  CFG.pred et s'
    from c1  Label l -et'p n'
    have "l < #:c1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c1 l c'" by(erule less_num_inner_nodes_label)
    hence "labels (c1;;c2) l (c';;c2)" by(rule Labels_Seq1)
    with ‹labels c1 l c' Vrhs (label (c1;; c2) l). state_val s V = state_val s' V
    have "Vrhs (label c1 l). state_val s V = state_val s' V" 
      by(fastforce dest:labels_label)
    with ‹IEdge et = et' show ?case by (rule IH)
  next
    case (Proc_CFG_SeqConnect c1 et' c2)
    note IH = IEdge et = et'; 
      Vrhs (label c1 l). state_val s V = state_val s' V
       CFG.pred et s'
    from c1  Label l -et'p Exit›
    have "l < #:c1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c1 l c'" by(erule less_num_inner_nodes_label)
    hence "labels (c1;;c2) l (c';;c2)" by(rule Labels_Seq1)
    with ‹labels c1 l c' Vrhs (label (c1;; c2) l). state_val s V = state_val s' V
    have "Vrhs (label c1 l). state_val s V = state_val s' V" 
      by(fastforce dest:labels_label)
    with ‹IEdge et = et' show ?case by (rule IH)
  next
    case (Proc_CFG_SeqSecond c2 n et' n' c1)
    note IH = l. n = Label l; IEdge et = et';
      Vrhs (label c2 l). state_val s V = state_val s' V 
       CFG.pred et s'
    from n  #:c1 = Label l obtain l' where "n = Label l'" and "l = l' + #:c1"
      by(cases n) auto
    from c2  n -et'p n' n = Label l'
    have "l' < #:c2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c2 l' c'" by(erule less_num_inner_nodes_label)
    with l = l' + #:c1 have "labels (c1;;c2) l c'" by(fastforce intro:Labels_Seq2)
    with ‹labels c2 l' c' Vrhs (label (c1;;c2) l). state_val s V = state_val s' V
    have "Vrhs (label c2 l'). state_val s V = state_val s' V" 
      by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et' show ?case by (rule IH)
  next
    case (Proc_CFG_CondTrue b c1 c2)
    from ‹CFG.pred et s ‹IEdge et = IEdge (λcf. state_check cf b (Some true))
    have "state_check (fst cf) b (Some true)" by simp
    moreover
    have "labels (if (b) c1 else c2) 0 (if (b) c1 else c2)" by(rule Labels_Base)
    hence "label (if (b) c1 else c2) 0 = if (b) c1 else c2" by(rule labels_label)
    with Vrhs (label (if (b) c1 else c2) 0). state_val s V = state_val s' V
    have "V fv b. state_val s V = state_val s' V" by fastforce
    ultimately have "state_check (fst cf') b (Some true)" 
      by simp(rule rhs_interpret_eq)
    with ‹IEdge et = IEdge (λcf. state_check cf b (Some true))
    show ?case by simp
  next
    case (Proc_CFG_CondFalse b c1 c2)
    from ‹CFG.pred et s 
      ‹IEdge et = IEdge (λcf. state_check cf b (Some false))
    have "state_check (fst cf) b (Some false)" by simp
    moreover
    have "labels (if (b) c1 else c2) 0 (if (b) c1 else c2)" by(rule Labels_Base)
    hence "label (if (b) c1 else c2) 0 = if (b) c1 else c2" by(rule labels_label)
    with Vrhs (label (if (b) c1 else c2) 0). state_val s V = state_val s' V
    have "V fv b. state_val s V = state_val s' V" by fastforce
    ultimately have "state_check (fst cf') b (Some false)" 
      by simp(rule rhs_interpret_eq)
    with ‹IEdge et = IEdge (λcf. state_check cf b (Some false)) 
    show ?case by simp
  next
    case (Proc_CFG_CondThen c1 n et' n' b c2)
    note IH = l. n = Label l; IEdge et = et';
      Vrhs (label c1 l). state_val s V = state_val s' V 
       CFG.pred et s'
    from n  1 = Label l obtain l' where "n = Label l'" and "l = l' + 1"
      by(cases n) auto
    from c1  n -et'p n' n = Label l'
    have "l' < #:c1" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c1 l' c'" by(erule less_num_inner_nodes_label)
    with l = l' + 1 have "labels (if (b) c1 else c2) l c'" 
      by(fastforce intro:Labels_CondTrue)
    with ‹labels c1 l' c' Vrhs (label (if (b) c1 else c2) l). 
      state_val s V = state_val s' V
    have "Vrhs (label c1 l'). state_val s V = state_val s' V"
      by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et' show ?case by (rule IH)
  next
    case (Proc_CFG_CondElse c2 n et' n' b c1)
    note IH = l. n = Label l; IEdge et = et';
      Vrhs (label c2 l). state_val s V = state_val s' V 
       CFG.pred et s'
    from n  #:c1 + 1= Label l obtain l' where "n = Label l'" and "l = l' + #:c1+1"
      by(cases n) auto
    from c2  n -et'p n' n = Label l'
    have "l' < #:c2" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain c' where "labels c2 l' c'" by(erule less_num_inner_nodes_label)
    with l = l' + #:c1 + 1 have "labels (if (b) c1 else c2) l c'" 
      by(fastforce intro:Labels_CondFalse)
    with ‹labels c2 l' c' Vrhs (label (if (b) c1 else c2) l). 
      state_val s V = state_val s' V
    have "Vrhs (label c2 l'). state_val s V = state_val s' V" 
      by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et' show ?case by (rule IH)
  next
    case (Proc_CFG_WhileTrue b c')
    from ‹CFG.pred et s ‹IEdge et = IEdge (λcf. state_check cf b (Some true))
    have "state_check (fst cf) b (Some true)" by simp
    moreover
    have "labels (while (b) c') 0 (while (b) c')" by(rule Labels_Base)
    hence "label (while (b) c') 0 = while (b) c'" by(rule labels_label)
    with Vrhs (label (while (b) c') 0). state_val s V = state_val s' V 
    have "V fv b. state_val s V = state_val s' V" by fastforce
    ultimately have "state_check (fst cf') b (Some true)" 
      by simp(rule rhs_interpret_eq)
    with ‹IEdge et = IEdge (λcf. state_check cf b (Some true))
    show ?case by simp
  next
    case (Proc_CFG_WhileFalse b c')
    from ‹CFG.pred et s
      ‹IEdge et = IEdge (λcf. state_check cf b (Some false))
    have "state_check (fst cf) b (Some false)" by simp
    moreover
    have "labels (while (b) c') 0 (while (b) c')" by(rule Labels_Base)
    hence "label (while (b) c') 0 = while (b) c'" by(rule labels_label)
    with Vrhs (label (while (b) c') 0). state_val s V = state_val s' V 
    have "V fv b. state_val s V = state_val s' V" by fastforce
    ultimately have "state_check (fst cf') b (Some false)" 
      by simp(rule rhs_interpret_eq)
    with ‹IEdge et = IEdge (λcf. state_check cf b (Some false))
    show ?case by simp
  next
    case (Proc_CFG_WhileBody c' n et' n' b)
    note IH = l. n = Label l; IEdge et = et';
      Vrhs (label c' l). state_val s V = state_val s' V 
       CFG.pred et s'
    from n  2 = Label l obtain l' where "n = Label l'" and "l = l' + 2"
      by(cases n) auto
    from c'  n -et'p n' n = Label l'
    have "l' < #:c'" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain cx where "labels c' l' cx" by(erule less_num_inner_nodes_label)
    with l = l' + 2 have "labels (while (b) c') l (cx;;while (b) c')" 
      by(fastforce intro:Labels_WhileBody)
    with ‹labels c' l' cx Vrhs (label (while (b) c') l). 
      state_val s V = state_val s' V
    have "Vrhs (label c' l'). state_val s V = state_val s' V" 
      by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et' show ?case by (rule IH)
  next
    case (Proc_CFG_WhileBodyExit c' n et' b)
    note IH = l. n = Label l; IEdge et = et';
      Vrhs (label c' l). state_val s V = state_val s' V 
       CFG.pred et s'
    from n  2 = Label l obtain l' where "n = Label l'" and "l = l' + 2"
      by(cases n) auto
    from c'  n -et'p Exit› n = Label l'
    have "l' < #:c'" by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
    then obtain cx where "labels c' l' cx" by(erule less_num_inner_nodes_label)
    with l = l' + 2 have "labels (while (b) c') l (cx;;while (b) c')" 
      by(fastforce intro:Labels_WhileBody)
    with ‹labels c' l' cx Vrhs (label (while (b) c') l). 
      state_val s V = state_val s' V
    have "Vrhs (label c' l'). state_val s V = state_val s' V" 
      by(fastforce dest:labels_label)
    with n = Label l' ‹IEdge et = et' show ?case by (rule IH)
  qed auto
qed



subsection ‹Instantiating the CFG_wf› locale›

interpretation ProcCFG_wf:
  CFG_wf sourcenode targetnode kind "valid_edge wfp" "(Main,Entry)"
  get_proc "get_return_edges wfp" "lift_procs wfp" Main 
  "Def wfp" "Use wfp" "ParamDefs wfp" "ParamUses wfp"
  for wfp
proof -
  from Rep_wf_prog[of wfp]
  obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)" 
    by(fastforce simp:wf_prog_def)
  hence "wf prog procs" by(rule wf_wf_prog)
  hence wf:"well_formed procs" by fastforce
  show "CFG_wf sourcenode targetnode kind (valid_edge wfp)
    (Main, Entry) get_proc (get_return_edges wfp) (lift_procs wfp) Main 
    (Def wfp) (Use wfp) (ParamDefs wfp) (ParamUses wfp)"
  proof
    from Entry_Def_empty Entry_Use_empty
    show "Def wfp (Main, Entry) = {}  Use wfp (Main, Entry) = {}" by simp
  next
    fix a Q r p fs ins outs
    assume "valid_edge wfp a" and "kind a = Q:rpfs" 
      and "(p, ins, outs)  set (lift_procs wfp)"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from this ‹kind a = Q:rpfs (p, ins, outs)  set (lift_procs wfp)
    show "length (ParamUses wfp (sourcenode a)) = length ins"
    proof(induct n"sourcenode a" et"kind a" n'"targetnode a" rule:PCFG.induct)
      case (MainCall l p' es rets n' insx outsx cx)
      with wf have [simp]:"insx = ins" by fastforce
      from prog  Label l -CEdge (p', es, rets)p n'
      have "containsCall procs prog [] p'" by(rule Proc_CFG_Call_containsCall)
      with ‹wf prog procs (p', insx, outsx, cx)  set procs 
        prog  Label l -CEdge (p', es, rets)p n'
      have "length es = length ins" by fastforce
      from prog  Label l -CEdge (p', es, rets)p n'
      have "ParamUses wfp (Main, Label l) = map fv es"
        by(fastforce intro:ParamUses_Main_Return_target)
      with (Main, Label l) = sourcenode a ‹length es = length ins
      show ?case by simp
    next
      case (ProcCall px insx outsx cx l p' es rets l' ins' outs' c' ps)
      with wf have [simp]:"ins' = ins" by fastforce
      from cx  Label l -CEdge (p', es, rets)p Label l'
      have "containsCall procs cx [] p'" by(rule Proc_CFG_Call_containsCall)
      with ‹containsCall procs prog ps px (px, insx, outsx, cx)  set procs
      have "containsCall procs prog (ps@[px]) p'" by(rule containsCall_in_proc)
      with ‹wf prog procs (p', ins', outs', c')  set procs
        cx  Label l -CEdge (p', es, rets)p Label l'
      have "length es = length ins" by fastforce
      from (px, insx, outsx, cx)  set procs
        cx  Label l -CEdge (p', es, rets)p Label l'
      have "ParamUses wfp (px,Label l) = map fv es"
        by(fastforce intro:ParamUses_Proc_Return_target simp:set_conv_nth)
      with (px, Label l) = sourcenode a ‹length es = length ins
      show ?case by simp
    qed auto
  next
    fix a assume "valid_edge wfp a"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    thus "distinct (ParamDefs wfp (targetnode a))"
    proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
      case (Main n n')
      from prog  n -IEdge (kind a)p n' (Main, n') = targetnode a
      have "ParamDefs wfp (Main,n') = []" by(fastforce intro:ParamDefs_Main_IEdge_Nil)
      with (Main, n') = targetnode a show ?case by simp
    next
      case (Proc p ins outs c n n')
      from (p, ins, outs, c)  set procs c  n -IEdge (kind a)p n'
      have "ParamDefs wfp (p,n') = []" by(fastforce intro:ParamDefs_Proc_IEdge_Nil)
      with (p, n') = targetnode a show ?case by simp
    next
      case (MainCall l p es rets n' ins outs c)
      with (p, ins, outs, c)  set procs wf have [simp]:"p  Main"
        by fastforce
      from wf (p, ins, outs, c)  set procs
      have "(THE c'. ins' outs'. (p,ins',outs',c')  set procs) = c"
        by(rule in_procs_THE_in_procs_cmd)
      with (p, Entry) = targetnode a[THEN sym] show ?case 
        by(auto simp:ParamDefs_def ParamDefs_proc_def)
    next
      case (ProcCall p ins outs c l p' es' rets' l' ins' outs' c')
      with (p', ins', outs', c')  set procs wf 
      have [simp]:"p'  Main" by fastforce
      from wf (p', ins', outs', c')  set procs
      have "(THE cx. insx outsx. (p',insx,outsx,cx)  set procs) = c'"
        by(rule in_procs_THE_in_procs_cmd)
      with (p', Entry) = targetnode a[THEN sym] show ?case 
        by(fastforce simp:ParamDefs_def ParamDefs_proc_def)
    next
      case (MainReturn l p es rets l' ins outs c)
      from prog  Label l -CEdge (p, es, rets)p Label l'
      have "containsCall procs prog [] p" by(rule Proc_CFG_Call_containsCall)
      with ‹wf prog procs (p, ins, outs, c)  set procs 
        prog  Label l -CEdge (p, es, rets)p Label l'
      have "distinct rets" by fastforce
      from prog  Label l -CEdge (p, es, rets)p Label l'
      have "ParamDefs wfp (Main,Label l') = rets"
        by(fastforce intro:ParamDefs_Main_Return_target)
      with ‹distinct rets (Main, Label l') = targetnode a show ?case
        by(fastforce simp:distinct_map inj_on_def)
    next
      case (ProcReturn p ins outs c l p' es' rets' l' ins' outs' c' ps)
      from c  Label l -CEdge (p', es', rets')p Label l'
      have "containsCall procs c [] p'" by(rule Proc_CFG_Call_containsCall)
      with ‹containsCall procs prog ps p (p, ins, outs, c)  set procs
      have "containsCall procs prog (ps@[p]) p'" by(rule containsCall_in_proc)
      with ‹wf prog procs (p', ins', outs', c')  set procs
        c  Label l -CEdge (p', es', rets')p Label l'
      have "distinct rets'" by fastforce
      from (p, ins, outs, c)  set procs
        c  Label l -CEdge (p', es', rets')p Label l'
      have "ParamDefs wfp (p,Label l') = rets'"
        by(fastforce intro:ParamDefs_Proc_Return_target simp:set_conv_nth)
      with ‹distinct rets' (p, Label l') = targetnode a show ?case 
        by(fastforce simp:distinct_map inj_on_def)
    next
      case (MainCallReturn n p es rets n')
      from prog  n -CEdge (p, es, rets)p n'
      have "containsCall procs prog [] p" by(rule Proc_CFG_Call_containsCall)
      with ‹wf prog procs obtain ins outs c where "(p, ins, outs, c)  set procs"
        by(simp add:wf_def) blast
      with ‹wf prog procs ‹containsCall procs prog [] p
        prog  n -CEdge (p, es, rets)p n'
      have "distinct rets" by fastforce
      from prog  n -CEdge (p, es, rets)p n'
      have "ParamDefs wfp (Main,n') = rets"
        by(fastforce intro:ParamDefs_Main_Return_target)
      with ‹distinct rets (Main, n') = targetnode a show ?case
        by(fastforce simp:distinct_map inj_on_def)
    next
      case (ProcCallReturn p ins outs c n p' es' rets' n' ps)
      from c  n -CEdge (p', es', rets')p n'
      have "containsCall procs c [] p'" by(rule Proc_CFG_Call_containsCall)
      from ‹Rep_wf_prog wfp = (prog,procs) (p, ins, outs, c)  set procs
        ‹containsCall procs prog ps p
      obtain wfp' where "Rep_wf_prog wfp' = (c,procs)" by(erule wfp_Call)
      hence "wf c procs" by(rule wf_wf_prog)
      with ‹containsCall procs c [] p' obtain ins' outs' c'
        where "(p', ins', outs', c')  set procs"
        by(simp add:wf_def) blast
      from ‹containsCall procs prog ps p (p, ins, outs, c)  set procs
        ‹containsCall procs c [] p'
      have "containsCall procs prog (ps@[p]) p'" by(rule containsCall_in_proc)
      with ‹wf prog procs (p', ins', outs', c')  set procs
        c  n -CEdge (p', es', rets')p n'
      have "distinct rets'" by fastforce
      from (p, ins, outs, c)  set procs c  n -CEdge (p', es', rets')p n'
      have "ParamDefs wfp (p,n') = rets'"
        by(fastforce intro:ParamDefs_Proc_Return_target)
      with ‹distinct rets' (p, n') = targetnode a show ?case
        by(fastforce simp:distinct_map inj_on_def)
    qed
  next
    fix a Q' p f' ins outs
    assume "valid_edge wfp a" and "kind a = Q'pf'"
      and "(p, ins, outs)  set (lift_procs wfp)"
    thus "length (ParamDefs wfp (targetnode a)) = length outs"
      by(rule ParamDefs_length)
  next
    fix n V assume "CFG.valid_node sourcenode targetnode (valid_edge wfp) n"
      and "V  set (ParamDefs wfp n)"
    thus "V  Def wfp n" by(simp add:Def_def)
  next
    fix a Q r p fs ins outs V
    assume "valid_edge wfp a" and "kind a = Q:rpfs"
      and "(p, ins, outs)  set (lift_procs wfp)" and "V  set ins"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from this ‹kind a = Q:rpfs (p, ins, outs)  set (lift_procs wfp) V  set ins
    show "V  Def wfp (targetnode a)"
    proof(induct n"sourcenode a" et"kind a" n'"targetnode a" rule:PCFG.induct)
      case (MainCall l p' es rets n' insx outsx cx)
      with wf have [simp]:"insx = ins" by fastforce
      from wf (p', insx, outsx, cx)  set procs 
      have "(THE ins'. c' outs'. (p',ins',outs',c')  set procs) = 
        insx" by(rule in_procs_THE_in_procs_ins)
      with (p', Entry) = targetnode a[THEN sym] V  set ins
        (p', insx, outsx, cx)  set procs show ?case by(auto simp:Def_def)
    next
      case (ProcCall px insx outsx cx l p' es rets l' ins' outs' c')
      with wf have [simp]:"ins' = ins" by fastforce
      from wf (p', ins', outs', c')  set procs 
      have "(THE insx. cx outsx. (p',insx,outsx,cx)  set procs) = 
        ins'" by(rule in_procs_THE_in_procs_ins)
      with (p', Entry) = targetnode a[THEN sym] V  set ins
        (p', ins', outs', c')  set procs show ?case by(auto simp:Def_def)
    qed auto
  next
    fix a Q r p fs
    assume "valid_edge wfp a" and "kind a = Q:rpfs"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from this ‹kind a = Q:rpfs show "Def wfp (sourcenode a) = {}"
    proof(induct n"sourcenode a" et"kind a" n'"targetnode a" rule:PCFG.induct)
      case (MainCall l p' es rets n' insx outsx cx)
      from (Main, Label l) = sourcenode a[THEN sym]
        prog  Label l -CEdge (p', es, rets)p n'
      have "ParamDefs wfp (sourcenode a) = []"
        by(fastforce intro:ParamDefs_Main_CEdge_Nil)
      with prog  Label l -CEdge (p', es, rets)p n'
        (Main, Label l) = sourcenode a[THEN sym]
      show ?case by(fastforce dest:Proc_CFG_Call_source_empty_lhs simp:Def_def)
    next
      case (ProcCall px insx outsx cx l p' es' rets' l' ins' outs' c')
      from (px, insx, outsx, cx)  set procs wf
      have [simp]:"px  Main" by fastforce
      from cx  Label l -CEdge (p', es', rets')p Label l'
      have "lhs (label cx l) = {}" by(rule Proc_CFG_Call_source_empty_lhs)
      from wf (px, insx, outsx, cx)  set procs
      have THE:"(THE c'. ins' outs'. (px,ins',outs',c')  set procs) = cx" 
        by(rule in_procs_THE_in_procs_cmd)
      with (px, Label l) = sourcenode a[THEN sym]
        cx  Label l -CEdge (p', es', rets')p Label l'  wf
      have "ParamDefs wfp (sourcenode a) = []"
        by(fastforce dest:Proc_CFG_Call_targetnode_no_Call_sourcenode
        [of _ _ _ _ _ "Label l"] simp:ParamDefs_def ParamDefs_proc_def)
      with (px, Label l) = sourcenode a[THEN sym] ‹lhs (label cx l) = {} THE
      show ?case by(auto simp:Def_def)
    qed auto
  next
    fix n V assume "CFG.valid_node sourcenode targetnode (valid_edge wfp) n"
      and "V  (set (ParamUses wfp n))"
    thus "V  Use wfp n" by(fastforce simp:Use_def)
  next
    fix a Q p f ins outs V
    assume "valid_edge wfp a" and "kind a = Qpf"
      and "(p, ins, outs)  set (lift_procs wfp)" and "V  set outs"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from this ‹kind a = Qpf (p, ins, outs)  set (lift_procs wfp) V  set outs
    show "V  Use wfp (sourcenode a)"
    proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
      case (MainReturn l p' es rets l' insx outsx cx)
      with wf have [simp]:"outsx = outs" by fastforce
      from wf (p', insx, outsx, cx)  set procs 
      have "(THE outs'. c' ins'. (p',ins',outs',c')  set procs) = 
        outsx" by(rule in_procs_THE_in_procs_outs)
      with (p', Exit) = sourcenode a[THEN sym] V  set outs
        (p', insx, outsx, cx)  set procs show ?case by(auto simp:Use_def)
    next
      case (ProcReturn px insx outsx cx l p' es' rets' l' ins' outs' c')
      with wf have [simp]:"outs' = outs" by fastforce
      from wf (p', ins', outs', c')  set procs 
      have "(THE outsx. cx insx. (p',insx,outsx,cx)  set procs) = 
        outs'" by(rule in_procs_THE_in_procs_outs)
      with (p', Exit) = sourcenode a[THEN sym] V  set outs
        (p', ins', outs', c')  set procs show ?case by(auto simp:Use_def)
    qed auto
  next
    fix a V s
    assume "valid_edge wfp a" and "V  Def wfp (sourcenode a)"
      and "intra_kind (kind a)" and "CFG.pred (kind a) s"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from this V  Def wfp (sourcenode a) ‹intra_kind (kind a) ‹CFG.pred (kind a) s
    show "state_val (CFG.transfer (lift_procs wfp) (kind a) s) V = state_val s V"
    proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
      case (Main n n')
      from ‹CFG.pred (kind a) s obtain cf cfs where "s = cf#cfs" by(cases s) auto
      show ?case
      proof(cases n)
        case (Label l)
        with V  Def wfp (sourcenode a) (Main, n) = sourcenode a
        have "V  lhs (label prog l)" by(fastforce simp:Def_def)
        with prog  n -IEdge (kind a)p n' n = Label l
        have "state_val (CFG.transfer (lift_procs wfp) (kind a) (cf#cfs)) V = fst cf V"
          by(fastforce intro:Proc_CFG_edge_no_lhs_equal)
        with s = cf#cfs show ?thesis by simp
      next
        case Entry
        with prog  n -IEdge (kind a)p n' s = cf#cfs
        show ?thesis 
          by(fastforce dest:Proc_CFG_EntryD simp:transfers_simps[of wfp,simplified])
      next
        case Exit
        with prog  n -IEdge (kind a)p n' have False by fastforce
        thus ?thesis by simp
      qed
    next
      case (Proc p ins outs c n n')
      from ‹CFG.pred (kind a) s obtain cf cfs where "s = cf#cfs" by(cases s) auto
      from wf (p, ins, outs, c)  set procs
      have THE1:"(THE ins'. c' outs'. (p,ins',outs',c')  set procs) = ins"
        by(rule in_procs_THE_in_procs_ins)
      from wf (p, ins, outs, c)  set procs
      have THE2:"(THE c'. ins' outs'. (p,ins',outs',c')  set procs) = c"
        by(rule in_procs_THE_in_procs_cmd)
      from wf (p, ins, outs, c)  set procs
      have [simp]:"p  Main" by fastforce
      show ?case
      proof(cases n)
        case (Label l)
        with V  Def wfp (sourcenode a) (p, n) = sourcenode a
          (p, ins, outs, c)  set procs wf THE1 THE2
        have "V  lhs (label c l)" by(fastforce simp:Def_def split:if_split_asm)
        with c  n -IEdge (kind a)p n' n = Label l
        have "state_val (CFG.transfer (lift_procs wfp) (kind a) (cf#cfs)) V = fst cf V"
          by(fastforce intro:Proc_CFG_edge_no_lhs_equal)
        with s = cf#cfs show ?thesis by simp
      next
        case Entry
        with c  n -IEdge (kind a)p n' s = cf#cfs
        show ?thesis
          by(fastforce dest:Proc_CFG_EntryD simp:transfers_simps[of wfp,simplified])
      next
        case Exit
        with c  n -IEdge (kind a)p n' have False by fastforce
        thus ?thesis by simp
      qed
    next
      case MainCallReturn thus ?case by(cases s,auto simp:intra_kind_def)
    next
      case ProcCallReturn thus ?case by(cases s,auto simp:intra_kind_def)
    qed(auto simp:intra_kind_def)
  next
    fix a s s'
    assume "valid_edge wfp a" 
      and "VUse wfp (sourcenode a). state_val s V = state_val s' V"
      and "intra_kind (kind a)" and "CFG.pred (kind a) s" and "CFG.pred (kind a) s'"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from ‹CFG.pred (kind a) s obtain cf cfs where [simp]:"s = cf#cfs" 
      by(cases s) auto
    from ‹CFG.pred (kind a) s' obtain cf' cfs' where [simp]:"s' = cf'#cfs'" 
      by(cases s') auto
    from prog,procs  sourcenode a -kind a targetnode a ‹intra_kind (kind a)
      VUse wfp (sourcenode a). state_val s V = state_val s' V
      ‹CFG.pred (kind a) s ‹CFG.pred (kind a) s'
    show "VDef wfp (sourcenode a). 
      state_val (CFG.transfer (lift_procs wfp) (kind a) s) V =
      state_val (CFG.transfer (lift_procs wfp) (kind a) s') V"
    proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
      case (Main n n')
      show ?case
      proof(cases n)
        case (Label l)
        with VUse wfp (sourcenode a). state_val s V = state_val s' V
          (Main, n) = sourcenode a[THEN sym]
        have rhs:"Vrhs (label prog l). state_val s V = state_val s' V"
          and PDef:"Vset (ParamDefs wfp (sourcenode a)). 
          state_val s V = state_val s' V"
          by(auto simp:Use_def)
        from rhs prog  n -IEdge (kind a)p n' n = Label l ‹CFG.pred (kind a) s 
          ‹CFG.pred (kind a) s'
        have lhs:"Vlhs (label prog l). 
          state_val (CFG.transfer (lift_procs wfp) (kind a) s) V =
          state_val (CFG.transfer (lift_procs wfp) (kind a) s') V"
          by -(rule Proc_CFG_edge_uses_only_rhs,auto)
        from PDef prog  n -IEdge (kind a)p n' (Main, n) = sourcenode a[THEN sym]
        have "Vset (ParamDefs wfp (sourcenode a)). 
          state_val (CFG.transfer (lift_procs wfp) (kind a) s) V =
          state_val (CFG.transfer (lift_procs wfp) (kind a) s') V"
          by(fastforce dest:Proc_CFG_Call_follows_id_edge 
            simp:ParamDefs_def ParamDefs_proc_def transfers_simps[of wfp,simplified]
            split:if_split_asm)
        with lhs (Main, n) = sourcenode a[THEN sym] Label show ?thesis
          by(fastforce simp:Def_def)
      next
        case Entry
        with (Main, n) = sourcenode a[THEN sym]
        show ?thesis by(fastforce simp:Entry_Def_empty)
      next
        case Exit
        with prog  n -IEdge (kind a)p n' have False by fastforce
        thus ?thesis by simp
      qed
    next
      case (Proc p ins outs c n n')
      show ?case
      proof(cases n)
        case (Label l)
        with VUse wfp (sourcenode a). state_val s V = state_val s' V wf
          (p, n) = sourcenode a[THEN sym] (p, ins, outs, c)  set procs
        have rhs:"Vrhs (label c l). state_val s V = state_val s' V"
          and PDef:"Vset (ParamDefs wfp (sourcenode a)). 
          state_val s V = state_val s' V"
          by(auto dest:in_procs_THE_in_procs_cmd simp:Use_def split:if_split_asm)
        from rhs c  n -IEdge (kind a)p n' n = Label l ‹CFG.pred (kind a) s 
          ‹CFG.pred (kind a) s'
        have lhs:"Vlhs (label c l). 
          state_val (CFG.transfer (lift_procs wfp) (kind a) s) V =
          state_val (CFG.transfer (lift_procs wfp) (kind a) s') V"
          by -(rule Proc_CFG_edge_uses_only_rhs,auto)
        from (p, ins, outs, c)  set procs wf have [simp]:"p  Main" by fastforce
        from wf (p, ins, outs, c)  set procs
        have THE:"(THE c'. ins' outs'. (p,ins',outs',c')  set procs) = c" 
          by(fastforce intro:in_procs_THE_in_procs_cmd)
        with PDef c  n -IEdge (kind a)p n' (p, n) = sourcenode a[THEN sym]
        have "Vset (ParamDefs wfp (sourcenode a)). 
          state_val (CFG.transfer (lift_procs wfp) (kind a) s) V =
          state_val (CFG.transfer (lift_procs wfp) (kind a) s') V"
          by(fastforce dest:Proc_CFG_Call_follows_id_edge 
            simp:ParamDefs_def ParamDefs_proc_def transfers_simps[of wfp,simplified]
            split:if_split_asm)
        with lhs (p, n) = sourcenode a[THEN sym] Label THE
        show ?thesis by(auto simp:Def_def)
      next
        case Entry
        with wf (p, ins, outs, c)  set procs have "ParamDefs wfp (p,n) = []"
          by(fastforce simp:ParamDefs_def ParamDefs_proc_def)
        moreover
        from Entry c  n -IEdge (kind a)p n' (p, ins, outs, c)  set procs
        have "ParamUses wfp (p,n) = []" by(fastforce intro:ParamUses_Proc_IEdge_Nil)
        ultimately have "Vset ins. state_val s V = state_val s' V"
          using wf (p, ins, outs, c)  set procs (p,n) = sourcenode a
          VUse wfp (sourcenode a). state_val s V = state_val s' V  Entry
          by(fastforce dest:in_procs_THE_in_procs_ins simp:Use_def split:if_split_asm)
        with c  n -IEdge (kind a)p n' Entry
        have "Vset ins. state_val (CFG.transfer (lift_procs wfp) (kind a) s) V =
          state_val (CFG.transfer (lift_procs wfp) (kind a) s') V"
          by(fastforce dest:Proc_CFG_EntryD simp:transfers_simps[of wfp,simplified])
        with (p,n) = sourcenode a[THEN sym] Entry wf  
          (p, ins, outs, c)  set procs ‹ParamDefs wfp (p,n) = []
        show ?thesis by(auto dest:in_procs_THE_in_procs_ins simp:Def_def)
      next
        case Exit
        with c  n -IEdge (kind a)p n' have False by fastforce
        thus ?thesis by simp
      qed
    qed(auto simp:intra_kind_def)
  next
    fix a s fix s'::"((char list  val) × node) list"
    assume "valid_edge wfp a" and "CFG.pred (kind a) s"
      and "VUse wfp (sourcenode a). state_val s V = state_val s' V" 
      and "length s = length s'" and "snd (hd s) = snd (hd s')"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from ‹CFG.pred (kind a) s obtain cf cfs where [simp]:"s = cf#cfs" 
      by(cases s) auto
    from ‹length s = length s' obtain cf' cfs' where [simp]:"s' = cf'#cfs'" 
      by(cases s') auto
    from prog,procs  sourcenode a -kind a targetnode a ‹CFG.pred (kind a) s
      VUse wfp (sourcenode a). state_val s V = state_val s' V
      ‹length s = length s' ‹snd (hd s) = snd (hd s')
    show "CFG.pred (kind a) s'"
    proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
      case (Main n n')
      show ?case
      proof(cases n)
        case (Label l)
        with VUse wfp (sourcenode a). state_val s V = state_val s' V
          (Main, n) = sourcenode a
        have "Vrhs (label prog l). state_val s V = state_val s' V" 
          by(fastforce simp:Use_def)
        with prog  n -IEdge (kind a)p n' Label ‹CFG.pred (kind a) s
          ‹length s = length s'
        show ?thesis by(fastforce intro:Proc_CFG_edge_rhs_pred_eq)
      next
        case Entry
        with prog  n -IEdge (kind a)p n' ‹CFG.pred (kind a) s
        show ?thesis by(fastforce dest:Proc_CFG_EntryD)
      next
        case Exit
        with prog  n -IEdge (kind a)p n' have False by fastforce
        thus ?thesis by simp
      qed
    next
      case (Proc p ins outs c n n')
      show ?case
      proof(cases n)
        case (Label l)
        with VUse wfp (sourcenode a). state_val s V = state_val s' V wf
          (p, n) = sourcenode a[THEN sym] (p, ins, outs, c)  set procs
        have "Vrhs (label c l). state_val s V = state_val s' V"
          by(auto dest:in_procs_THE_in_procs_cmd simp:Use_def split:if_split_asm)
        with c  n -IEdge (kind a)p n' Label ‹CFG.pred (kind a) s
          ‹length s = length s'
        show ?thesis by(fastforce intro:Proc_CFG_edge_rhs_pred_eq)
      next
        case Entry
        with c  n -IEdge (kind a)p n' ‹CFG.pred (kind a) s
        show ?thesis by(fastforce dest:Proc_CFG_EntryD)
      next
        case Exit
        with c  n -IEdge (kind a)p n' have False by fastforce
        thus ?thesis by simp
      qed
    next
      case (MainReturn l p es rets l' ins outs c)
      with λcf. snd cf = (Main, Label l')pλcf cf'. cf'(rets [:=] map cf outs) =
        kind a[THEN sym]
      show ?case by fastforce
    next
      case (ProcReturn p ins outs c l p' es rets l' ins' outs' c')
      with λcf. snd cf = (p, Label l')p'λcf cf'. cf'(rets [:=] map cf outs') =
        kind a[THEN sym]
      show ?case by fastforce
    qed(auto dest:sym)
  next
    fix a Q r p fs ins outs
    assume "valid_edge wfp a" and "kind a = Q:rpfs"
      and "(p, ins, outs)  set (lift_procs wfp)"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from this ‹kind a = Q:rpfs (p, ins, outs)  set (lift_procs wfp)
    show "length fs = length ins"
    proof(induct rule:PCFG.induct)
      case (MainCall l p' es rets n' ins' outs' c)
      hence "fs = map interpret es" and "p' = p" by simp_all
      with wf (p, ins, outs)  set (lift_procs wfp)
        (p', ins', outs', c)  set procs
      have [simp]:"ins' = ins" by fastforce
      from prog  Label l -CEdge (p', es, rets)p n'
      have "containsCall procs prog [] p'" by(rule Proc_CFG_Call_containsCall)
      with ‹wf prog procs (p', ins', outs', c)  set procs
        prog  Label l -CEdge (p', es, rets)p n'
      have "length es = length ins" by fastforce
      with fs = map interpret es show ?case by simp
    next
      case (ProcCall px insx outsx c l p' es' rets' l' ins' outs' c' ps)
      hence "fs = map interpret es'" and "p' = p" by simp_all
      with wf (p, ins, outs)  set (lift_procs wfp)
        (p', ins', outs', c')  set procs
      have [simp]:"ins' = ins" by fastforce
      from c  Label l -CEdge (p', es', rets')p Label l'
      have "containsCall procs c [] p'" by(rule Proc_CFG_Call_containsCall)
      with ‹containsCall procs prog ps px (px, insx, outsx, c)  set procs
      have "containsCall procs prog (ps@[px]) p'" by(rule containsCall_in_proc)
      with ‹wf prog procs (p', ins', outs', c')  set procs
        c  Label l -CEdge (p', es', rets')p Label l'
      have "length es' = length ins" by fastforce
      with fs = map interpret es' show ?case by simp
    qed auto
  next
    fix a Q r p fs a' Q' r' p' fs' s s'
    assume "valid_edge wfp a" and "kind a = Q:rpfs"
      and "valid_edge wfp a'" and "kind a' = Q':r'p'fs'" 
      and "sourcenode a = sourcenode a'"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      and "prog,procs  sourcenode a' -kind a' targetnode a'"
      by(simp_all add:valid_edge_def)
    from this ‹kind a = Q:rpfs ‹kind a' = Q':r'p'fs' show "a = a'"
    proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
      case (MainCall l px es rets n' insx outsx cx)
      from prog,procs  sourcenode a' -kind a' targetnode a'
        ‹kind a' = Q':r'p'fs' 
        (Main, Label l) = sourcenode a ‹sourcenode a = sourcenode a'
        prog  Label l -CEdge (px, es, rets)p n' wf
      have "targetnode a' = (px, Entry)"
        by(fastforce elim!:PCFG.cases dest:Proc_CFG_Call_nodes_eq)
      with ‹valid_edge wfp a ‹valid_edge wfp a'
        ‹sourcenode a = sourcenode a' (px, Entry) = targetnode a wf
      have "kind a = kind a'" by(fastforce intro:Proc_CFG_edge_det simp:valid_edge_def)
      with ‹sourcenode a = sourcenode a' (px, Entry) = targetnode a
        ‹targetnode a' = (px, Entry)
      show ?case by(cases a,cases a',auto)
    next
      case (ProcCall px ins outs c l px' es rets l' insx outsx cx)
      with wf have "px  Main" by fastforce
      with prog,procs  sourcenode a' -kind a' targetnode a'
        ‹kind a' = Q':r'p'fs'
        (px, Label l) = sourcenode a ‹sourcenode a = sourcenode a'
        c  Label l -CEdge (px', es, rets)p Label l'
        (px', insx, outsx, cx)  set procs (px, ins, outs, c)  set procs
      have "targetnode a' = (px', Entry)"
      proof(induct n"sourcenode a'" et"kind a'" n'"targetnode a'" rule:PCFG.induct)
        case (ProcCall p insa outsa ca la p'a es' rets' l'a ins' outs' c')
        hence [simp]:"px = p" "l = la" by(auto dest:sym)
        from (p, insa, outsa, ca)  set procs
          (px, ins, outs, c)  set procs wf have [simp]:"ca = c"  by auto
        from ca  Label la -CEdge (p'a, es', rets')p Label l'a
          c  Label l -CEdge (px', es, rets)p Label l'
        have "p'a = px'" by(fastforce dest:Proc_CFG_Call_nodes_eq)
        with (p'a, Entry) = targetnode a' show ?case by simp
      qed(auto dest:sym)
      with ‹valid_edge wfp a ‹valid_edge wfp a'
        ‹sourcenode a = sourcenode a' (px', Entry) = targetnode a wf
      have "kind a = kind a'" by(fastforce intro:Proc_CFG_edge_det simp:valid_edge_def)
      with ‹sourcenode a = sourcenode a' (px', Entry) = targetnode a
        ‹targetnode a' = (px', Entry) show ?case by(cases a,cases a',auto)
    qed auto
  next
    fix a Q r p fs i ins outs fix s s'::"((char list  val) × node) list"
    assume "valid_edge wfp a" and "kind a = Q:rpfs" and "i < length ins"
      and "(p, ins, outs)  set (lift_procs wfp)"
      and "VParamUses wfp (sourcenode a) ! i. state_val s V = state_val s' V"
    hence "prog,procs  sourcenode a -kind a targetnode a"
      by(simp add:valid_edge_def)
    from this ‹kind a = Q:rpfs i < length ins 
      (p, ins, outs)  set (lift_procs wfp) 
      VParamUses wfp (sourcenode a) ! i. state_val s V = state_val s' V
    show "CFG.params fs (state_val s) ! i = CFG.params fs (state_val s') ! i"
    proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
      case (MainCall l p' es rets n' insx outsx cx)
      with wf have [simp]:"insx = ins" "fs = map interpret es" by auto
      from prog  Label l -CEdge (p', es, rets)p n'
      have "containsCall procs prog [] p'" by(rule Proc_CFG_Call_containsCall)
      with ‹wf prog procs (p', insx, outsx, cx)  set procs 
        prog  Label l -CEdge (p', es, rets)p n'
      have "length es = length ins" by fastforce
      with i < length ins have "i < length (map interpret es)" by simp
      from prog  Label l -CEdge (p', es, rets)p n'
      have "ParamUses wfp (Main,Label l) = map fv es"
        by(fastforce intro:ParamUses_Main_Return_target)
      with VParamUses wfp (sourcenode a) ! i. state_val s V = state_val s' V
        i < length (map interpret es) (Main, Label l) = sourcenode a
      have " ((map (λe cf. interpret e cf) es)!i) (fst (hd s)) = 
        ((map (λe cf. interpret e cf) es)!i) (fst (hd s'))"
        by(cases "interpret (es ! i) (fst (hd s))")(auto dest:rhs_interpret_eq)
      with i < length (map interpret es) show ?case by(simp add:ProcCFG.params_nth)
    next
      case (ProcCall px insx outsx cx l p' es' rets' l' ins' outs' c' ps)
      with wf have [simp]:"ins' = ins" by fastforce
      from cx  Label l -CEdge (p', es', rets')p Label l'
      have "containsCall procs cx [] p'" by(rule Proc_CFG_Call_containsCall)
      with ‹containsCall procs prog ps px (px, insx, outsx, cx)  set procs
      have "containsCall procs prog (ps@[px]) p'" by(rule containsCall_in_proc)
      with ‹wf prog procs (p', ins', outs', c')  set procs
        cx  Label l -CEdge (p', es', rets')p Label l'
      have "length es' = length ins" by fastforce
      from λs. True:(px, Label l')p'map interpret es' = kind a ‹kind a = Q:rpfs
      have "fs = map interpret es'" by simp_all
      from i < length ins fs = map interpret es' 
        ‹length es' = length ins have "i < length fs" by simp
      from (px, insx, outsx, cx)  set procs
        cx  Label l -CEdge (p', es', rets')p Label l'
      have "ParamUses wfp (px,Label l) = map fv es'"
        by(auto intro!:ParamUses_Proc_Return_target simp:set_conv_nth)
      with VParamUses wfp (sourcenode a) ! i. state_val s V = state_val s' V
        (px, Label l) = sourcenode a i < length fs 
        fs = map interpret es'
      have " ((map (λe cf. interpret e cf) es')!i) (fst (hd s)) = 
        ((map (λe cf. interpret e cf) es')!i) (fst (hd s'))"
        by(cases "interpret (es' ! i) (fst (hd s))")(auto dest:rhs_interpret_eq)
      with i < length fs fs = map interpret es' 
      show ?case by(simp add:ProcCFG.params_nth)
    qed auto
  next
    fix a Q' p f' ins outs cf cf'
    assume "valid_edge wfp a" and "kind a = Q'pf'"
      and "(p, ins, outs)  set (lift_procs wfp)"
    thus "f' cf cf' = cf'(ParamDefs wfp (targetnode a) [:=] map cf outs)"
      by(rule Return_update)
  next
    fix a a'
    assume "valid_edge wfp a" and "valid_edge wfp a'"
      and "sourcenode a = sourcenode a'" and "targetnode a  targetnode a'"
      and "intra_kind (kind a)" and "intra_kind (kind a')"
    with wf show "Q Q'. kind a = (Q)  kind a' = (Q')  
      (cf. (Q cf  ¬ Q' cf)  (Q' cf  ¬ Q cf))"
      by(auto dest:Proc_CFG_deterministic simp:valid_edge_def)
  qed
qed


subsection ‹Instantiating the CFGExit_wf› locale›

interpretation ProcCFGExit_wf:
  CFGExit_wf sourcenode targetnode kind "valid_edge wfp" "(Main,Entry)"
  get_proc "get_return_edges wfp" "lift_procs wfp" Main "(Main,Exit)"
  "Def wfp" "Use wfp" "ParamDefs wfp" "ParamUses wfp"
  for wfp
proof
  from Exit_Def_empty Exit_Use_empty
  show "Def wfp (Main, Exit) = {}  Use wfp (Main, Exit) = {}" by simp
qed


end

Theory ValidPaths

section ‹Lemmas concerning paths to instantiate locale Postdomination›

theory ValidPaths imports WellFormed "../StaticInter/Postdomination" begin

subsection ‹Intraprocedural paths from method entry and to method exit›


abbreviation path :: "wf_prog  node  edge list  node  bool" ("_  _ -_→* _")
  where "wfp  n -as→* n'  CFG.path sourcenode targetnode (valid_edge wfp) n as n'"

definition label_incrs :: "edge list  nat  edge list" ("_ ⊕s _" 60)
  where "as ⊕s i  map (λ((p,n),et,(p',n')). ((p,n  i),et,(p',n'  i))) as"


declare One_nat_def [simp del]



subsubsection ‹From prog› to prog;;c2


lemma Proc_CFG_edge_SeqFirst_nodes_Label:
  "prog  Label l -etp Label l'  prog;;c2  Label l -etp Label l'"
proof(induct prog "Label l" et "Label l'" rule:Proc_CFG.induct)
  case (Proc_CFG_SeqSecond c2' n et n' c1)
  hence "(c1;; c2');; c2  n  #:c1 -etp n'  #:c1"
    by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_SeqSecond)
  with n  #:c1 = Label l n'  #:c1 = Label l' show ?case by fastforce
next
  case (Proc_CFG_CondThen c1 n et n' b c2')
  hence "if (b) c1 else c2';; c2  n  1 -etp n'  1"
    by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_CondThen)
  with n  1 = Label l n'  1 = Label l' show ?case by fastforce
next
  case (Proc_CFG_CondElse c1 n et n' b c2')
  hence "if (b) c2' else c1 ;; c2  n  #:c2' + 1 -etp n'  (#:c2' + 1)"   
    by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_CondElse)
  with n  #:c2' + 1 = Label l n'  #:c2' + 1 = Label l' show ?case by fastforce
next
  case (Proc_CFG_WhileBody c' n et n' b)
  hence "while (b) c';; c2  n  2 -etp n'  2"
    by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_WhileBody)
  with n  2 = Label l n'  2 = Label l' show ?case by fastforce
next
  case (Proc_CFG_WhileBodyExit c' n et b)
  hence "while (b) c';; c2  n  2 -etp Label 0"
    by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_WhileBodyExit)
  with n  2 = Label l 0 = l' show ?case by fastforce
qed (auto intro:Proc_CFG.intros)


lemma Proc_CFG_edge_SeqFirst_source_Label:
  assumes "prog  Label l -etp n'"
  obtains nx where "prog;;c2  Label l -etp nx"
proof(atomize_elim)
  from prog  Label l -etp n' obtain n where "prog  n -etp n'" and "Label l = n"
    by simp
  thus "nx. prog;;c2  Label l -etp nx"
  proof(induct prog n et n' rule:Proc_CFG.induct)
    case (Proc_CFG_SeqSecond c2' n et n' c1)
    show ?case
    proof(cases "n' = Exit")
      case True
      with c2'  n -etp n' n  Entry› have "c1;; c2'  n  #:c1 -etp Exit  #:c1"
        by(fastforce intro:Proc_CFG.Proc_CFG_SeqSecond)
      moreover from n  Entry› have "n  #:c1  Entry" by(cases n) auto
      ultimately
      have "c1;; c2';; c2  n  #:c1 -etp Label (#:c1;; c2')"
        by(fastforce intro:Proc_CFG_SeqConnect)
      with ‹Label l = n  #:c1 show ?thesis by fastforce
    next
      case False
      with Proc_CFG_SeqSecond
      have "(c1;; c2');; c2  n  #:c1 -etp n'  #:c1"
        by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_SeqSecond)
      with ‹Label l = n  #:c1 show ?thesis by fastforce
    qed
  next
    case (Proc_CFG_CondThen c1 n et n' b c2')
    show ?case
    proof(cases "n' = Exit")
      case True
      with c1  n -etp n' n  Entry›
      have "if (b) c1 else c2'  n  1 -etp Exit  1"
        by(fastforce intro:Proc_CFG.Proc_CFG_CondThen)
      moreover from n  Entry› have "n  1  Entry" by(cases n) auto
      ultimately
      have "if (b) c1 else c2';; c2  n  1 -etp Label (#:if (b) c1 else c2')"
        by(fastforce intro:Proc_CFG_SeqConnect)
      with ‹Label l = n  1 show ?thesis by fastforce
    next
      case False
      hence "n'  1  Exit" by(cases n') auto
      with Proc_CFG_CondThen
      have  "if (b) c1 else c2';; c2  Label l -etp n'  1"
        by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_CondThen)
      with ‹Label l = n  1 show ?thesis by fastforce
    qed
  next
    case (Proc_CFG_CondElse c1 n et n' b c2')
    show ?case
    proof(cases "n' = Exit")
      case True
      with c1  n -etp n' n  Entry›
      have "if (b) c2' else c1  n  (#:c2' + 1) -etp Exit  (#:c2' + 1)"
        by(fastforce intro:Proc_CFG.Proc_CFG_CondElse)
      moreover from n  Entry› have "n  (#:c2' + 1)  Entry" by(cases n) auto
      ultimately
      have "if (b) c2' else c1;; c2  n  (#:c2' + 1) -etp 
        Label (#:if (b) c2' else c1)"
        by(fastforce intro:Proc_CFG_SeqConnect)
      with ‹Label l = n  (#:c2' + 1) show ?thesis by fastforce
    next
      case False
      hence "n'  (#:c2' + 1)  Exit" by(cases n') auto
      with Proc_CFG_CondElse
      have  "if (b) c2' else c1 ;; c2  Label l -etp n'  (#:c2' + 1)"
        by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_CondElse)
      with ‹Label l = n  (#:c2' + 1) show ?thesis by fastforce
    qed
  qed (auto intro:Proc_CFG.intros)
qed


lemma Proc_CFG_edge_SeqFirst_target_Label:
  "prog  n -etp n'; Label l' = n'  prog;;c2  n -etp Label l'"
proof(induct prog n et n' rule:Proc_CFG.induct)
  case (Proc_CFG_SeqSecond c2' n et n' c1)
  from ‹Label l' = n'  #:c1 have "n'  Exit" by(cases n') auto
  with Proc_CFG_SeqSecond
  show ?case by(fastforce intro:Proc_CFG_SeqFirst intro:Proc_CFG.Proc_CFG_SeqSecond)
next
  case (Proc_CFG_CondThen c1 n et n' b c2')
  from ‹Label l' = n'  1 have "n'  Exit" by(cases n') auto
  with Proc_CFG_CondThen
  show ?case by(fastforce intro:Proc_CFG_SeqFirst Proc_CFG.Proc_CFG_CondThen)
qed (auto intro:Proc_CFG.intros)


lemma PCFG_edge_SeqFirst_source_Label:
  assumes "prog,procs  (p,Label l) -et (p',n')"
  obtains nx where "prog;;c2,procs  (p,Label l) -et (p',nx)"
proof(atomize_elim)
  from prog,procs  (p,Label l) -et (p',n')
  show "nx. prog;;c2,procs  (p,Label l) -et (p',nx)"
  proof(induct "(p,Label l)" et "(p',n')" rule:PCFG.induct)
    case (Main et)
    from prog  Label l -IEdge etp n'
    obtain nx' where "prog;;c2  Label l -IEdge etp nx'"
      by(auto elim:Proc_CFG_edge_SeqFirst_source_Label)
    with ‹Main = p ‹Main = p' show ?case 
      by(fastforce dest:PCFG.Main)
  next
    case (Proc ins outs c et ps)
    from ‹containsCall procs prog ps p
    have "containsCall procs (prog;;c2) ps p" by simp
    with Proc show ?case by(fastforce dest:PCFG.Proc)
  next
    case (MainCall es rets nx ins outs c)
    from prog  Label l -CEdge (p', es, rets)p nx
    obtain lx where [simp]:"nx = Label lx" by(fastforce dest:Proc_CFG_Call_Labels)
    with prog  Label l -CEdge (p', es, rets)p nx
    have "prog;;c2  Label l -CEdge (p', es, rets)p Label lx"
      by(auto intro:Proc_CFG_edge_SeqFirst_nodes_Label)
    with MainCall show ?case by(fastforce dest:PCFG.MainCall)
  next
    case (ProcCall ins outs c es' rets' l' ins' outs' c' ps)
    from ‹containsCall procs prog ps p 
    have "containsCall procs (prog;;c2) ps p" by simp
    with ProcCall show ?case by(fastforce intro:PCFG.ProcCall)
  next
    case (MainCallReturn px es rets)
    from prog  Label l -CEdge (px, es, rets)p n' ‹Main = p
    obtain nx'' where "prog;;c2  Label l -CEdge (px, es, rets)p nx''"
      by(auto elim:Proc_CFG_edge_SeqFirst_source_Label)
    with MainCallReturn show ?case by(fastforce dest:PCFG.MainCallReturn)
  next
    case (ProcCallReturn ins outs c px' es' rets' ps)
    from ‹containsCall procs prog ps p
    have "containsCall procs (prog;;c2) ps p" by simp
    with ProcCallReturn show ?case by(fastforce dest!:PCFG.ProcCallReturn)
  qed
qed


lemma PCFG_edge_SeqFirst_target_Label:
  "prog,procs  (p,n) -et (p',Label l') 
   prog;;c2,procs  (p,n) -et (p',Label l')"
proof(induct "(p,n)" et "(p',Label l')" rule:PCFG.induct)
  case Main
  thus ?case by(fastforce dest:Proc_CFG_edge_SeqFirst_target_Label intro:PCFG.Main)
next
  case (Proc ins outs c et ps)
  from ‹containsCall procs prog ps p 
  have "containsCall procs (prog;;c2) ps p" by simp
  with Proc show ?case by(fastforce dest:PCFG.Proc)
next
  case MainReturn thus ?case
    by(fastforce dest:Proc_CFG_edge_SeqFirst_target_Label 
               intro!:PCFG.MainReturn[simplified])
next
  case (ProcReturn ins outs c lx es' rets' ins' outs' c' ps)
  from ‹containsCall procs prog ps p' 
  have "containsCall procs (prog;;c2) ps p'" by simp
  with ProcReturn show ?case by(fastforce intro:PCFG.ProcReturn)
next
  case MainCallReturn thus ?case
  by(fastforce dest:Proc_CFG_edge_SeqFirst_target_Label intro:PCFG.MainCallReturn)
next
  case (ProcCallReturn ins outs c px' es' rets' ps)
  from ‹containsCall procs prog ps p 
  have "containsCall procs (prog;;c2) ps p" by simp
  with ProcCallReturn show ?case by(fastforce dest!:PCFG.ProcCallReturn)
qed


lemma path_SeqFirst:
  assumes "Rep_wf_prog wfp = (prog,procs)" and "Rep_wf_prog wfp' = (prog;;c2,procs)"
  shows "wfp  (p,n) -as→* (p,Label l); a  set as. intra_kind (kind a)
   wfp'  (p,n) -as→* (p,Label l)"
proof(induct "(p,n)" as "(p,Label l)" arbitrary:n rule:ProcCFG.path.induct)
  case empty_path
  from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (p, Label l) 
    ‹Rep_wf_prog wfp = (prog, procs) ‹Rep_wf_prog wfp' = (prog;; c2, procs)
  have "CFG.valid_node sourcenode targetnode (valid_edge wfp') (p, Label l)"
    apply(auto simp:ProcCFG.valid_node_def valid_edge_def)
    apply(erule PCFG_edge_SeqFirst_source_Label,fastforce)
    by(drule PCFG_edge_SeqFirst_target_Label,fastforce)
  thus ?case by(fastforce intro:ProcCFG.empty_path)
next
  case (Cons_path n'' as a nx)
  note IH = n. n'' = (p, n); aset as. intra_kind (kind a)
     wfp'  (p, n) -as→* (p, Label l)
  note [simp] = ‹Rep_wf_prog wfp = (prog,procs) ‹Rep_wf_prog wfp' = (prog;;c2,procs)
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  from aset (a # as). intra_kind (kind a) have "intra_kind (kind a)"
    and "aset as. intra_kind (kind a)" by simp_all
  from ‹valid_edge wfp a ‹sourcenode a = (p, nx) ‹targetnode a = n''
    ‹intra_kind (kind a) wf 
  obtain nx' where "n'' = (p,nx')"
    by(auto elim:PCFG.cases simp:valid_edge_def intra_kind_def)
  from IH[OF this aset as. intra_kind (kind a)]
  have path:"wfp'  (p, nx') -as→* (p, Label l)" .
  have "valid_edge wfp' a"
  proof(cases nx')
    case (Label lx)
    with ‹valid_edge wfp a ‹sourcenode a = (p, nx) ‹targetnode a = n''
      n'' = (p,nx') show ?thesis
      by(fastforce intro:PCFG_edge_SeqFirst_target_Label 
                   simp:intra_kind_def valid_edge_def)
  next
    case Entry
    with ‹valid_edge wfp a ‹targetnode a = n'' n'' = (p,nx')
      ‹intra_kind (kind a) have False 
      by(auto elim:PCFG.cases simp:valid_edge_def intra_kind_def)
    thus ?thesis by simp
  next
    case Exit
    with path aset as. intra_kind (kind a) have False 
      by(induct "(p,nx')" as "(p,Label l)" rule:ProcCFG.path.induct)
    (auto elim!:PCFG.cases simp:valid_edge_def intra_kind_def)
    thus ?thesis by simp
  qed
  with ‹sourcenode a = (p, nx) ‹targetnode a = n'' n'' = (p,nx') path
  show ?case by(fastforce intro:ProcCFG.Cons_path)
qed


subsubsection ‹From prog› to c1;;prog›

lemma Proc_CFG_edge_SeqSecond_source_not_Entry:
  "prog  n -etp n'; n  Entry  c1;;prog  n  #:c1 -etp n'  #:c1"
by(induct rule:Proc_CFG.induct)(fastforce intro:Proc_CFG_SeqSecond Proc_CFG.intros)+


lemma PCFG_Main_edge_SeqSecond_source_not_Entry:
  "prog,procs  (Main,n) -et (p',n'); n  Entry; intra_kind et; well_formed procs
   c1;;prog,procs  (Main,n  #:c1) -et (p',n'  #:c1)"
proof(induct "(Main,n)" et "(p',n')" rule:PCFG.induct)
  case Main
  thus ?case
    by(fastforce dest:Proc_CFG_edge_SeqSecond_source_not_Entry intro:PCFG.Main)
next
  case (MainCallReturn p es rets)
  from prog  n -CEdge (p, es, rets)p n' n  Entry›
  have "c1;;prog  n  #:c1 -CEdge (p, es, rets)p n'  #:c1"
    by(rule Proc_CFG_edge_SeqSecond_source_not_Entry)
  with MainCallReturn show ?case by(fastforce intro:PCFG.MainCallReturn)
qed (auto simp:intra_kind_def)


lemma valid_node_Main_SeqSecond:
  assumes "CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)"
  and "n  Entry" and "Rep_wf_prog wfp = (prog,procs)" 
  and "Rep_wf_prog wfp' = (c1;;prog,procs)"
  shows "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n  #:c1)"
proof -
  note [simp] = ‹Rep_wf_prog wfp = (prog,procs) ‹Rep_wf_prog wfp' = (c1;;prog,procs)
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)
  obtain a where "prog,procs  sourcenode a -kind a targetnode a"
    and "(Main,n) = sourcenode a  (Main,n) = targetnode a"
    by(fastforce simp:ProcCFG.valid_node_def valid_edge_def)
  from this n  Entry› wf show ?thesis
  proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
    case (Main nx nx')
    from (Main,n) = sourcenode a  (Main,n) = targetnode a show ?case
    proof
      assume "(Main,n) = sourcenode a"
      with (Main, nx) = sourcenode a[THEN sym] have [simp]:"nx = n" by simp
      from n  Entry› prog  nx -IEdge (kind a)p nx'
      have "c1;;prog  n  #:c1 -IEdge (kind a)p nx'  #:c1"
        by(fastforce intro:Proc_CFG_edge_SeqSecond_source_not_Entry)
      hence "c1;;prog,procs  (Main,n  #:c1) -kind a (Main,nx'  #:c1)"
        by(rule PCFG.Main)
      thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
    next
      assume "(Main, n) = targetnode a"
      show ?thesis
      proof(cases "nx = Entry")
        case True
        with prog  nx -IEdge (kind a)p nx' 
        have "nx' = Exit  nx' = Label 0" by(fastforce dest:Proc_CFG_EntryD)
        thus ?thesis
        proof
          assume "nx' = Exit"
          with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
          show ?thesis by simp
        next
          assume "nx' = Label 0"
          obtain l etx where "c1  Label l -IEdge etxp Exit" and "l  #:c1"
            by(erule Proc_CFG_Exit_edge)
          hence "c1;;prog  Label l -IEdge etxp Label #:c1"
            by(fastforce intro:Proc_CFG_SeqConnect)
          with nx' = Label 0 
          have "c1;;prog,procs  (Main,Label l) -etx (Main,nx'#:c1)"
            by(fastforce intro:PCFG.Main)
          with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
          show ?thesis
            by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
        qed
      next
        case False
        with prog  nx -IEdge (kind a)p nx'
        have "c1;;prog  nx  #:c1 -IEdge (kind a)p nx'  #:c1"
          by(fastforce intro:Proc_CFG_edge_SeqSecond_source_not_Entry)
        hence "c1;;prog,procs  (Main,nx  #:c1) -kind a (Main,nx'  #:c1)"
          by(rule PCFG.Main)
        with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
        show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
      qed
    qed
  next
    case (Proc p ins outs c nx n' ps)
    from (p, nx) = sourcenode a[THEN sym] (p, n') = targetnode a[THEN sym]
      (Main, n) = sourcenode a  (Main, n) = targetnode a 
      (p, ins, outs, c)  set procs ‹well_formed procs have False by fastforce
    thus ?case by simp
  next
    case (MainCall l p es rets n' ins outs c)
    from (p, ins, outs, c)  set procs wf (p, Entry) = targetnode a[THEN sym]
      (Main, Label l) = sourcenode a[THEN sym]
      (Main, n) = sourcenode a  (Main, n) = targetnode a
     have [simp]:"n = Label l" by fastforce
    from prog  Label l -CEdge (p, es, rets)p n'
    have "c1;;prog  Label l  #:c1 -CEdge (p, es, rets)p n'  #:c1"
      by -(rule Proc_CFG_edge_SeqSecond_source_not_Entry,auto)
    with (p, ins, outs, c)  set procs
    have "c1;;prog,procs  (Main,Label (l + #:c1)) 
      -(λs. True):(Main,n'  #:c1)pmap (λe cf. interpret e cf) es (p,Entry)"
      by(fastforce intro:PCFG.MainCall)
    thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
  next
    case (ProcCall p ins outs c l p' es' rets' l' ins' outs' c')
    from (p, Label l) = sourcenode a[THEN sym]
      (p', Entry) = targetnode a[THEN sym]  ‹well_formed procs
      (p, ins, outs, c)  set procs (p', ins', outs', c')  set procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  next
    case (MainReturn l p es rets l' ins outs c)
    from (p, ins, outs, c)  set procs wf (p, Exit) = sourcenode a[THEN sym]
      (Main, Label l') = targetnode a[THEN sym]
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have [simp]:"n = Label l'" by fastforce
    from prog  Label l -CEdge (p, es, rets)p Label l'
    have "c1;;prog  Label l  #:c1 -CEdge (p, es, rets)p Label l'  #:c1"
      by -(rule Proc_CFG_edge_SeqSecond_source_not_Entry,auto)
    with (p, ins, outs, c)  set procs
    have "c1;;prog,procs  (p,Exit) -(λcf. snd cf = (Main,Label l'  #:c1))p
      (λcf cf'. cf'(rets [:=] map cf outs)) (Main,Label (l' + #:c1))"
      by(fastforce intro:PCFG.MainReturn)
    thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
  next
    case (ProcReturn p ins outs c l p' es' rets' l' ins' outs' c' ps)
    from (p', Exit) = sourcenode a[THEN sym] 
      (p, Label l') = targetnode a[THEN sym] ‹well_formed procs
      (p, ins, outs, c)  set procs (p', ins', outs', c')  set procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  next
    case (MainCallReturn nx p es rets nx')
    from (Main,n) = sourcenode a  (Main,n) = targetnode a show ?case
    proof
      assume "(Main,n) = sourcenode a"
      with (Main, nx) = sourcenode a[THEN sym] have [simp]:"nx = n" by simp
      from n  Entry› prog  nx -CEdge (p, es, rets)p nx'
      have "c1;;prog  n  #:c1 -CEdge (p, es, rets)p nx'  #:c1"
        by(fastforce intro:Proc_CFG_edge_SeqSecond_source_not_Entry)
      hence "c1;;prog,procs  (Main,n  #:c1) -(λs. False) (Main,nx'  #:c1)"
        by -(rule PCFG.MainCallReturn)
      thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
    next
      assume "(Main, n) = targetnode a"
      from prog  nx -CEdge (p, es, rets)p nx'
      have "nx  Entry" by(fastforce dest:Proc_CFG_Call_Labels)
      with prog  nx -CEdge (p, es, rets)p nx'
      have "c1;;prog  nx  #:c1 -CEdge (p, es, rets)p nx'  #:c1"
        by(fastforce intro:Proc_CFG_edge_SeqSecond_source_not_Entry)
      hence "c1;;prog,procs  (Main,nx  #:c1) -(λs. False) (Main,nx'  #:c1)"
        by -(rule PCFG.MainCallReturn)
      with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym] 
      show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
    qed
  next
    case (ProcCallReturn p ins outs c nx p' es' rets' n' ps)
    from (p, nx) = sourcenode a[THEN sym] (p, n') = targetnode a[THEN sym]
      (p, ins, outs, c)  set procs ‹well_formed procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  qed
qed


lemma path_Main_SeqSecond:
  assumes "Rep_wf_prog wfp = (prog,procs)" and "Rep_wf_prog wfp' = (c1;;prog,procs)"
  shows "wfp  (Main,n) -as→* (p',n'); a  set as. intra_kind (kind a); n  Entry
   wfp'  (Main,n  #:c1) -as ⊕s #:c1→* (p',n'  #:c1)"
proof(induct "(Main,n)" as "(p',n')" arbitrary:n rule:ProcCFG.path.induct)
  case empty_path
  from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main, n')
    n'  Entry› ‹Rep_wf_prog wfp = (prog,procs) 
    ‹Rep_wf_prog wfp' = (c1;;prog,procs)
  have "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n'  #:c1)"
    by(fastforce intro:valid_node_Main_SeqSecond)
  with ‹Main = p' show ?case
    by(fastforce intro:ProcCFG.empty_path simp:label_incrs_def)
next
  case (Cons_path n'' as a n)
  note IH = n.  n'' = (Main, n); aset as. intra_kind (kind a); n  Entry 
     wfp'  (Main, n  #:c1) -as ⊕s #:c1→* (p', n'  #:c1)
  note [simp] = ‹Rep_wf_prog wfp = (prog,procs) ‹Rep_wf_prog wfp' = (c1;;prog,procs)
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  from aset (a # as). intra_kind (kind a) have "intra_kind (kind a)"
    and "aset as. intra_kind (kind a)" by simp_all
  from ‹valid_edge wfp a ‹sourcenode a = (Main, n) ‹targetnode a = n''
    ‹intra_kind (kind a) wf 
  obtain nx'' where "n'' = (Main,nx'')" and "nx''  Entry"
    by(auto elim!:PCFG.cases simp:valid_edge_def intra_kind_def)
  from IH[OF n'' = (Main,nx'') aset as. intra_kind (kind a) nx''  Entry›]
  have path:"wfp'  (Main, nx''  #:c1) -as ⊕s #:c1→* (p', n'  #:c1)" .
  from ‹valid_edge wfp a ‹sourcenode a = (Main, n) ‹targetnode a = n''
    n'' = (Main,nx'') n  Entry› ‹intra_kind (kind a) wf
  have "c1;; prog,procs  (Main, n  #:c1) -kind a (Main, nx''  #:c1)"
    by(fastforce intro:PCFG_Main_edge_SeqSecond_source_not_Entry simp:valid_edge_def)
  with path ‹sourcenode a = (Main, n) ‹targetnode a = n'' n'' = (Main,nx'')
  show ?case apply(cases a) apply(clarsimp simp:label_incrs_def)
    by(auto intro:ProcCFG.Cons_path simp:valid_edge_def)
qed


subsubsection ‹From prog› to if (b) prog else c2

lemma Proc_CFG_edge_CondTrue_source_not_Entry:
  "prog  n -etp n'; n  Entry  if (b) prog else c2  n  1 -etp n'  1"
by(induct rule:Proc_CFG.induct)(fastforce intro:Proc_CFG_CondThen Proc_CFG.intros)+


lemma PCFG_Main_edge_CondTrue_source_not_Entry:
  "prog,procs  (Main,n) -et (p',n'); n  Entry; intra_kind et; well_formed procs
   if (b) prog else c2,procs  (Main,n  1) -et (p',n'  1)"
proof(induct "(Main,n)" et "(p',n')" rule:PCFG.induct)
  case Main
  thus ?case by(fastforce dest:Proc_CFG_edge_CondTrue_source_not_Entry intro:PCFG.Main)
next
  case (MainCallReturn p es rets)
  from prog  n -CEdge (p, es, rets)p n' n  Entry›
  have "if (b) prog else c2  n  1 -CEdge (p, es, rets)p n'  1"
    by(rule Proc_CFG_edge_CondTrue_source_not_Entry)
  with MainCallReturn show ?case by(fastforce intro:PCFG.MainCallReturn)
qed (auto simp:intra_kind_def)


lemma valid_node_Main_CondTrue:
  assumes "CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)"
  and "n  Entry" and "Rep_wf_prog wfp = (prog,procs)" 
  and "Rep_wf_prog wfp' = (if (b) prog else c2,procs)"
  shows "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n  1)"
proof -
  note [simp] = ‹Rep_wf_prog wfp = (prog,procs) 
    ‹Rep_wf_prog wfp' = (if (b) prog else c2,procs)
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)
  obtain a where "prog,procs  sourcenode a -kind a targetnode a"
    and "(Main,n) = sourcenode a  (Main,n) = targetnode a"
    by(fastforce simp:ProcCFG.valid_node_def valid_edge_def)
  from this n  Entry› wf show ?thesis
  proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
    case (Main nx nx')
    from (Main,n) = sourcenode a  (Main,n) = targetnode a show ?case
    proof
      assume "(Main,n) = sourcenode a"
      with (Main, nx) = sourcenode a[THEN sym] have [simp]:"nx = n" by simp
      from n  Entry› prog  nx -IEdge (kind a)p nx'
      have "if (b) prog else c2  n  1 -IEdge (kind a)p nx'  1"
        by(fastforce intro:Proc_CFG_edge_CondTrue_source_not_Entry)
      hence "if (b) prog else c2,procs  (Main,n  1) -kind a (Main,nx'  1)"
        by(rule PCFG.Main)
      thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
    next
      assume "(Main, n) = targetnode a"
      show ?thesis
      proof(cases "nx = Entry")
        case True
        with prog  nx -IEdge (kind a)p nx'
        have "nx' = Exit  nx' = Label 0" by(fastforce dest:Proc_CFG_EntryD)
        thus ?thesis
        proof
          assume "nx' = Exit"
          with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
          show ?thesis by simp
        next
          assume "nx' = Label 0"
          have "if (b) prog else c2  Label 0 
            -IEdge (λcf. state_check cf b (Some true))p Label 1"
            by(rule Proc_CFG_CondTrue)
          with nx' = Label 0 
          have "if (b) prog else c2,procs  (Main,Label 0) 
            -(λcf. state_check cf b (Some true)) (Main,nx'  1)" 
            by(fastforce intro:PCFG.Main)
          with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
          show ?thesis
            by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
        qed
      next
        case False
        with prog  nx -IEdge (kind a)p nx'
        have "if (b) prog else c2  nx  1 -IEdge (kind a)p nx'  1"
          by(fastforce intro:Proc_CFG_edge_CondTrue_source_not_Entry)
        hence "if (b) prog else c2,procs  (Main,nx  1) -kind a 
          (Main,nx'  1)" by(rule PCFG.Main)
        with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
        show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
      qed
    qed
  next
    case (Proc p ins outs c nx n' ps)
    from (p, nx) = sourcenode a[THEN sym] (p, n') = targetnode a[THEN sym]
      (p, ins, outs, c)  set procs ‹well_formed procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  next
    case (MainCall l p es rets n' ins outs c)
    from (p, ins, outs, c)  set procs (p, Entry) = targetnode a[THEN sym] 
      (Main, Label l) = sourcenode a[THEN sym] wf
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have [simp]:"n = Label l" by fastforce
    from prog  Label l -CEdge (p, es, rets)p n'
    have "if (b) prog else c2  Label l  1 -CEdge (p, es, rets)p n'  1"
      by -(rule Proc_CFG_edge_CondTrue_source_not_Entry,auto)
    with (p, ins, outs, c)  set procs
    have "if (b) prog else c2,procs  (Main,Label (l + 1)) 
      -(λs. True):(Main,n'  1)pmap (λe cf. interpret e cf) es (p,Entry)"
      by(fastforce intro:PCFG.MainCall)
    thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
  next
    case (ProcCall p ins outs c l p' es' rets' l' ins' outs' c' ps)
    from (p, Label l) = sourcenode a[THEN sym] 
      (p', Entry) = targetnode a[THEN sym] ‹well_formed procs 
      (p, ins, outs, c)  set procs (p', ins', outs', c')  set procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  next
    case (MainReturn l p es rets l' ins outs c)
    from (p, ins, outs, c)  set procs (p, Exit) = sourcenode a[THEN sym] 
      (Main, Label l') = targetnode a[THEN sym] wf
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have [simp]:"n = Label l'" by fastforce
    from prog  Label l -CEdge (p, es, rets)p Label l'
    have "if (b) prog else c2  Label l  1 -CEdge (p, es, rets)p Label l'  1"
      by -(rule Proc_CFG_edge_CondTrue_source_not_Entry,auto)
    with (p, ins, outs, c)  set procs
    have "if (b) prog else c2,procs  (p,Exit) -(λcf. snd cf = (Main,Label l'  1))p
      (λcf cf'. cf'(rets [:=] map cf outs)) (Main,Label (l' + 1))"
      by(fastforce intro:PCFG.MainReturn)
    thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
  next
    case (ProcReturn p ins outs c l p' es' rets' l' ins' outs' c' ps)
    from (p', Exit) = sourcenode a[THEN sym] 
      (p, Label l') = targetnode a[THEN sym] ‹well_formed procs
      (p, ins, outs, c)  set procs (p', ins', outs', c')  set procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  next
    case (MainCallReturn nx p es rets nx')
    from (Main,n) = sourcenode a  (Main,n) = targetnode a show ?case
    proof
      assume "(Main,n) = sourcenode a"
      with (Main, nx) = sourcenode a[THEN sym] have [simp]:"nx = n" by simp
      from n  Entry› prog  nx -CEdge (p, es, rets)p nx'
      have "if (b) prog else c2  n  1 -CEdge (p, es, rets)p nx'  1"
        by(fastforce intro:Proc_CFG_edge_CondTrue_source_not_Entry)
      hence "if (b) prog else c2,procs  (Main,n  1) -(λs. False) 
        (Main,nx'  1)" by -(rule PCFG.MainCallReturn)
      thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
    next
      assume "(Main, n) = targetnode a"
      from prog  nx -CEdge (p, es, rets)p nx'
      have "nx  Entry" by(fastforce dest:Proc_CFG_Call_Labels)
      with prog  nx -CEdge (p, es, rets)p nx'
      have "if (b) prog else c2  nx  1 -CEdge (p, es, rets)p nx'  1"
        by(fastforce intro:Proc_CFG_edge_CondTrue_source_not_Entry)
      hence "if (b) prog else c2,procs  (Main,nx  1) -(λs. False) (Main,nx'  1)"
        by -(rule PCFG.MainCallReturn)
      with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
      show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
    qed
  next
    case (ProcCallReturn p ins outs c nx p' es' rets' n' ps)
    from (p, nx) = sourcenode a[THEN sym] (p, n') = targetnode a[THEN sym]
      (p, ins, outs, c)  set procs ‹well_formed procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  qed
qed


lemma path_Main_CondTrue:
  assumes "Rep_wf_prog wfp = (prog,procs)" 
  and "Rep_wf_prog wfp' = (if (b) prog else c2,procs)"
  shows "wfp  (Main,n) -as→* (p',n'); a  set as. intra_kind (kind a); n  Entry
   wfp'  (Main,n  1) -as ⊕s 1→* (p',n'  1)"
proof(induct "(Main,n)" as "(p',n')" arbitrary:n rule:ProcCFG.path.induct)
  case empty_path
  from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main, n')
    n'  Entry› ‹Rep_wf_prog wfp = (prog,procs) 
    ‹Rep_wf_prog wfp' = (if (b) prog else c2,procs)
  have "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n'  1)" 
    by(fastforce intro:valid_node_Main_CondTrue)
  with ‹Main = p' show ?case
    by(fastforce intro:ProcCFG.empty_path simp:label_incrs_def)
next
  case (Cons_path n'' as a n)
  note IH = n.  n'' = (Main, n); aset as. intra_kind (kind a); n  Entry 
     wfp'  (Main, n  1) -as ⊕s 1→* (p', n'  1)
  note [simp] = ‹Rep_wf_prog wfp = (prog,procs) 
    ‹Rep_wf_prog wfp' = (if (b) prog else c2,procs)
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  from aset (a # as). intra_kind (kind a) have "intra_kind (kind a)"
    and "aset as. intra_kind (kind a)" by simp_all
  from ‹valid_edge wfp a ‹sourcenode a = (Main, n) ‹targetnode a = n''
    ‹intra_kind (kind a) wf 
  obtain nx'' where "n'' = (Main,nx'')" and "nx''  Entry"
    by(auto elim!:PCFG.cases simp:valid_edge_def intra_kind_def)
  from IH[OF n'' = (Main,nx'') aset as. intra_kind (kind a) nx''  Entry›]
  have path:"wfp'  (Main, nx''  1) -as ⊕s 1→* (p', n'  1)" .
  from ‹valid_edge wfp a ‹sourcenode a = (Main, n) ‹targetnode a = n''
    n'' = (Main,nx'') n  Entry› ‹intra_kind (kind a) wf
  have "if (b) prog else c2,procs  (Main, n  1) -kind a (Main, nx''  1)"
    by(fastforce intro:PCFG_Main_edge_CondTrue_source_not_Entry simp:valid_edge_def)
  with path ‹sourcenode a = (Main, n) ‹targetnode a = n'' n'' = (Main,nx'')
  show ?case
    apply(cases a) apply(clarsimp simp:label_incrs_def)
    by(auto intro:ProcCFG.Cons_path simp:valid_edge_def)
qed


subsubsection ‹From prog› to if (b) c1 else prog›

lemma Proc_CFG_edge_CondFalse_source_not_Entry:
  "prog  n -etp n'; n  Entry 
   if (b) c1 else prog  n  (#:c1 + 1) -etp n'  (#:c1 + 1)"
by(induct rule:Proc_CFG.induct)(fastforce intro:Proc_CFG_CondElse Proc_CFG.intros)+


lemma PCFG_Main_edge_CondFalse_source_not_Entry:
  "prog,procs  (Main,n) -et (p',n'); n  Entry; intra_kind et; well_formed procs
   if (b) c1 else prog,procs  (Main,n  (#:c1 + 1)) -et (p',n'  (#:c1 + 1))"
proof(induct "(Main,n)" et "(p',n')" rule:PCFG.induct)
  case Main
  thus ?case 
    by(fastforce dest:Proc_CFG_edge_CondFalse_source_not_Entry intro:PCFG.Main)
next
  case (MainCallReturn p es rets)
  from prog  n -CEdge (p, es, rets)p n' n  Entry›
  have "if (b) c1 else prog  n  (#:c1 + 1) -CEdge (p, es, rets)p n'  (#:c1 + 1)"
    by(rule Proc_CFG_edge_CondFalse_source_not_Entry)
  with MainCallReturn show ?case by(fastforce intro:PCFG.MainCallReturn)
qed (auto simp:intra_kind_def)


lemma valid_node_Main_CondFalse:
  assumes "CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)"
  and "n  Entry" and "Rep_wf_prog wfp = (prog,procs)" 
  and "Rep_wf_prog wfp' = (if (b) c1 else prog,procs)"
  shows "CFG.valid_node sourcenode targetnode (valid_edge wfp') 
  (Main, n  (#:c1 + 1))"
proof -
  note [simp] = ‹Rep_wf_prog wfp = (prog,procs) 
    ‹Rep_wf_prog wfp' = (if (b) c1 else prog,procs)
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)
  obtain a where "prog,procs  sourcenode a -kind a targetnode a"
    and "(Main,n) = sourcenode a  (Main,n) = targetnode a"
    by(fastforce simp:ProcCFG.valid_node_def valid_edge_def)
  from this n  Entry› wf show ?thesis
  proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
    case (Main nx nx')
    from (Main,n) = sourcenode a  (Main,n) = targetnode a show ?case
    proof
      assume "(Main,n) = sourcenode a"
      with (Main, nx) = sourcenode a[THEN sym] have [simp]:"nx = n" by simp
      from n  Entry› prog  nx -IEdge (kind a)p nx'
      have "if (b) c1 else prog  n  (#:c1 + 1) -IEdge (kind a)p nx'  (#:c1 + 1)"
        by(fastforce intro:Proc_CFG_edge_CondFalse_source_not_Entry)
      hence "if (b) c1 else prog,procs  (Main,n  (#:c1 + 1)) -kind a 
        (Main,nx'  (#:c1 + 1))" by(rule PCFG.Main)
      thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
    next
      assume "(Main, n) = targetnode a"
      show ?thesis
      proof(cases "nx = Entry")
        case True
        with prog  nx -IEdge (kind a)p nx' 
        have "nx' = Exit  nx' = Label 0" by(fastforce dest:Proc_CFG_EntryD)
        thus ?thesis
        proof
          assume "nx' = Exit"
          with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
          show ?thesis by simp
        next
          assume "nx' = Label 0"
          have "if (b) c1 else prog  Label 0 
            -IEdge (λcf. state_check cf b (Some false))p Label (#:c1 + 1)"
            by(rule Proc_CFG_CondFalse)
          with nx' = Label 0 
          have "if (b) c1 else prog,procs  (Main,Label 0) 
            -(λcf. state_check cf b (Some false)) (Main,nx'  (#:c1 + 1))" 
            by(fastforce intro:PCFG.Main)
          with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
          show ?thesis
            by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
        qed
      next
        case False
        with prog  nx -IEdge (kind a)p nx'
        have "if (b) c1 else prog  nx  (#:c1 + 1) -IEdge (kind a)p nx'  (#:c1 + 1)"
          by(fastforce intro:Proc_CFG_edge_CondFalse_source_not_Entry)
        hence "if (b) c1 else prog,procs  (Main,nx  (#:c1 + 1)) -kind a 
          (Main,nx'  (#:c1 + 1))" by(rule PCFG.Main)
        with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym] 
        show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
      qed
    qed
  next
    case (Proc p ins outs c nx n' ps)
    from (p, nx) = sourcenode a[THEN sym] (p, n') = targetnode a[THEN sym]
      (p, ins, outs, c)  set procs ‹well_formed procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  next
    case (MainCall l p es rets n' ins outs c)
    from (p, ins, outs, c)  set procs (p, Entry) = targetnode a[THEN sym]
      (Main, Label l) = sourcenode a[THEN sym] wf
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have [simp]:"n = Label l" by fastforce
    from prog  Label l -CEdge (p, es, rets)p n'
    have "if (b) c1 else prog  Label l  (#:c1 + 1) -CEdge (p, es, rets)p 
      n'  (#:c1 + 1)" by -(rule Proc_CFG_edge_CondFalse_source_not_Entry,auto)
    with (p, ins, outs, c)  set procs
    have "if (b) c1 else prog,procs  (Main,Label (l + (#:c1 + 1))) 
      -(λs. True):(Main,n'  (#:c1 + 1))pmap (λe cf. interpret e cf) es (p,Entry)"
      by(fastforce intro:PCFG.MainCall)
    thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
  next
    case (ProcCall p ins outs c l p' es' rets' l' ins' outs' c' ps)
    from (p, Label l) = sourcenode a[THEN sym]
      (p', Entry) = targetnode a[THEN sym]  ‹well_formed procs
      (p, ins, outs, c)  set procs (p', ins', outs', c')  set procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  next
    case (MainReturn l p es rets l' ins outs c)
    from (p, ins, outs, c)  set procs (p, Exit) = sourcenode a[THEN sym]
      (Main, Label l') = targetnode a[THEN sym] wf
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have [simp]:"n = Label l'" by fastforce
    from prog  Label l -CEdge (p, es, rets)p Label l'
    have "if (b) c1 else prog  Label l  (#:c1 + 1) -CEdge (p, es, rets)p 
      Label l'  (#:c1 + 1)" by -(rule Proc_CFG_edge_CondFalse_source_not_Entry,auto)
    with (p, ins, outs, c)  set procs
    have "if (b) c1 else prog,procs  (p,Exit) 
      -(λcf. snd cf = (Main,Label l'  (#:c1 + 1)))p
      (λcf cf'. cf'(rets [:=] map cf outs)) (Main,Label (l' + (#:c1 + 1)))"
      by(fastforce intro:PCFG.MainReturn)
    thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
  next
    case (ProcReturn p ins outs c l p' es' rets' l' ins' outs' c' ps)
    from (p', Exit) = sourcenode a[THEN sym] 
      (p, Label l') = targetnode a[THEN sym] ‹well_formed procs
      (p, ins, outs, c)  set procs (p', ins', outs', c')  set procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  next
    case (MainCallReturn nx p es rets nx')
    from (Main,n) = sourcenode a  (Main,n) = targetnode a show ?case
    proof
      assume "(Main,n) = sourcenode a"
      with (Main, nx) = sourcenode a[THEN sym] have [simp]:"nx = n" by simp
      from n  Entry› prog  nx -CEdge (p, es, rets)p nx'
      have "if (b) c1 else prog  n  (#:c1 + 1) -CEdge (p, es, rets)p 
        nx'  (#:c1 + 1)" by(fastforce intro:Proc_CFG_edge_CondFalse_source_not_Entry)
      hence "if (b) c1 else prog,procs  (Main,n  (#:c1 + 1)) 
        -(λs. False) (Main,nx'  (#:c1 + 1))" by -(rule PCFG.MainCallReturn)
      thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
    next
      assume "(Main, n) = targetnode a"
      from prog  nx -CEdge (p, es, rets)p nx'
      have "nx  Entry" by(fastforce dest:Proc_CFG_Call_Labels)
      with prog  nx -CEdge (p, es, rets)p nx'
      have "if (b) c1 else prog  nx  (#:c1 + 1) -CEdge (p, es, rets)p 
        nx'  (#:c1 + 1)" by(fastforce intro:Proc_CFG_edge_CondFalse_source_not_Entry)
      hence "if (b) c1 else prog,procs  (Main,nx  (#:c1 + 1)) 
        -(λs. False) (Main,nx'  (#:c1 + 1))" by -(rule PCFG.MainCallReturn)
      with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
      show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
    qed
  next
    case (ProcCallReturn p ins outs c nx p' es' rets' n' ps)
    from (p, nx) = sourcenode a[THEN sym] (p, n') = targetnode a[THEN sym]
      (p, ins, outs, c)  set procs ‹well_formed procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  qed
qed


lemma path_Main_CondFalse:
  assumes "Rep_wf_prog wfp = (prog,procs)" 
  and "Rep_wf_prog wfp' = (if (b) c1 else prog,procs)"
  shows "wfp  (Main,n) -as→* (p',n'); a  set as. intra_kind (kind a); n  Entry
   wfp'  (Main,n  (#:c1 + 1)) -as ⊕s (#:c1 + 1)→* (p',n'  (#:c1 + 1))"
proof(induct "(Main,n)" as "(p',n')" arbitrary:n rule:ProcCFG.path.induct)
  case empty_path
  from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main, n')
    n'  Entry› ‹Rep_wf_prog wfp = (prog,procs) 
    ‹Rep_wf_prog wfp' = (if (b) c1 else prog,procs)
  have "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n'  (#:c1 + 1))"
    by(fastforce intro:valid_node_Main_CondFalse)
  with ‹Main = p' show ?case
    by(fastforce intro:ProcCFG.empty_path simp:label_incrs_def)
next
  case (Cons_path n'' as a n)
  note IH = n. n.  n'' = (Main, n); aset as. intra_kind (kind a); n  Entry
     wfp'  (Main, n  (#:c1 + 1)) -as ⊕s (#:c1 + 1)→* (p', n'  (#:c1 + 1))
  note [simp] = ‹Rep_wf_prog wfp = (prog,procs) 
    ‹Rep_wf_prog wfp' = (if (b) c1 else prog,procs)
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  from aset (a # as). intra_kind (kind a) have "intra_kind (kind a)"
    and "aset as. intra_kind (kind a)" by simp_all
  from ‹valid_edge wfp a ‹sourcenode a = (Main, n) ‹targetnode a = n''
    ‹intra_kind (kind a) wf 
  obtain nx'' where "n'' = (Main,nx'')" and "nx''  Entry"
    by(auto elim!:PCFG.cases simp:valid_edge_def intra_kind_def)
  from IH[OF n'' = (Main,nx'') aset as. intra_kind (kind a) nx''  Entry›]
  have path:"wfp'  (Main, nx''  (#:c1 + 1)) -as ⊕s (#:c1 + 1)→* 
    (p', n'  (#:c1 + 1))" .
  from ‹valid_edge wfp a ‹sourcenode a = (Main, n) ‹targetnode a = n''
    n'' = (Main,nx'') n  Entry› ‹intra_kind (kind a) wf
  have "if (b) c1 else prog,procs  (Main, n  (#:c1 + 1)) -kind a 
    (Main, nx''  (#:c1 + 1))"
    by(fastforce intro:PCFG_Main_edge_CondFalse_source_not_Entry simp:valid_edge_def)
  with path ‹sourcenode a = (Main, n) ‹targetnode a = n'' n'' = (Main,nx'')
  show ?case
    apply(cases a) apply(clarsimp simp:label_incrs_def)
    by(auto intro:ProcCFG.Cons_path simp:valid_edge_def)
qed


subsubsection ‹From prog› to while (b) prog›

lemma Proc_CFG_edge_WhileBody_source_not_Entry:
  "prog  n -etp n'; n  Entry; n'  Exit 
   while (b) prog  n  2 -etp n'  2"
by(induct rule:Proc_CFG.induct)(fastforce intro:Proc_CFG_WhileBody Proc_CFG.intros)+


lemma PCFG_Main_edge_WhileBody_source_not_Entry:
  "prog,procs  (Main,n) -et (p',n'); n  Entry; n'  Exit; intra_kind et; 
  well_formed procs  while (b) prog,procs  (Main,n  2) -et (p',n'  2)"
proof(induct "(Main,n)" et "(p',n')" rule:PCFG.induct)
  case Main
  thus ?case 
    by(fastforce dest:Proc_CFG_edge_WhileBody_source_not_Entry intro:PCFG.Main)
next
  case (MainCallReturn p es rets)
  from prog  n -CEdge (p, es, rets)p n' n  Entry› n'  Exit›
  have "while (b) prog  n  2 -CEdge (p, es, rets)p n'  2"
    by(rule Proc_CFG_edge_WhileBody_source_not_Entry)
  with MainCallReturn show ?case by(fastforce intro:PCFG.MainCallReturn)
qed (auto simp:intra_kind_def)


lemma valid_node_Main_WhileBody:
  assumes "CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)"
  and "n  Entry" and "Rep_wf_prog wfp = (prog,procs)" 
  and "Rep_wf_prog wfp' = (while (b) prog,procs)"
  shows "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n  2)"
proof -
  note [simp] = ‹Rep_wf_prog wfp = (prog,procs) 
    ‹Rep_wf_prog wfp' = (while (b) prog,procs)
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main,n)
  obtain a where "prog,procs  sourcenode a -kind a targetnode a"
    and "(Main,n) = sourcenode a  (Main,n) = targetnode a"
    by(fastforce simp:ProcCFG.valid_node_def valid_edge_def)
  from this n  Entry› wf show ?thesis
  proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
    case (Main nx nx')
    from (Main,n) = sourcenode a  (Main,n) = targetnode a show ?case
    proof
      assume "(Main,n) = sourcenode a"
      with (Main, nx) = sourcenode a[THEN sym] have [simp]:"nx = n" by simp
      show ?thesis
      proof(cases "nx' = Exit")
        case True
        with n  Entry› prog  nx -IEdge (kind a)p nx'
        have "while (b) prog  n  2 -IEdge (kind a)p Label 0"
          by(fastforce intro:Proc_CFG_WhileBodyExit)
        hence "while (b) prog,procs  (Main,n  2) -kind a (Main,Label 0)"
          by(rule PCFG.Main)
        thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
      next
        case False
        with n  Entry› prog  nx -IEdge (kind a)p nx'
        have "while (b) prog  n  2 -IEdge (kind a)p nx'  2"
          by(fastforce intro:Proc_CFG_edge_WhileBody_source_not_Entry)
        hence "while (b) prog,procs  (Main,n  2) -kind a (Main,nx'  2)"
          by(rule PCFG.Main)
        thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
      qed
    next
      assume "(Main, n) = targetnode a"
      show ?thesis
      proof(cases "nx = Entry")
        case True
        with prog  nx -IEdge (kind a)p nx' 
        have "nx' = Exit  nx' = Label 0" by(fastforce dest:Proc_CFG_EntryD)
        thus ?thesis
        proof
          assume "nx' = Exit"
          with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
          show ?thesis by simp
        next
          assume "nx' = Label 0"
          have "while (b) prog  Label 0 
            -IEdge (λcf. state_check cf b (Some true))p Label 2"
            by(rule Proc_CFG_WhileTrue)
          hence "while (b) prog,procs  (Main,Label 0) 
            -(λcf. state_check cf b (Some true)) (Main,Label 2)"
            by(fastforce intro:PCFG.Main)
          with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
            nx' = Label 0 show ?thesis
            by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
        qed
      next
        case False
        show ?thesis
        proof(cases "nx' = Exit")
          case True
          with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
          show ?thesis by simp
        next
          case False
          with prog  nx -IEdge (kind a)p nx' nx  Entry›
          have "while (b) prog  nx  2 -IEdge (kind a)p nx'  2"
            by(fastforce intro:Proc_CFG_edge_WhileBody_source_not_Entry)
          hence "while (b) prog,procs  (Main,nx  2)  -kind a 
            (Main,nx'  2)" by(rule PCFG.Main)
          with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym]
          show ?thesis
            by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
        qed
      qed
    qed
  next
    case (Proc p ins outs c nx n' ps)
    from (p, nx) = sourcenode a[THEN sym] (p, n') = targetnode a[THEN sym]
      (Main, n) = sourcenode a  (Main, n) = targetnode a 
      (p, ins, outs, c)  set procs ‹well_formed procs 
    have False by fastforce
    thus ?case by simp
  next
    case (MainCall l p es rets n' ins outs c)
    from (p, ins, outs, c)  set procs (p, Entry) = targetnode a[THEN sym]
      (Main, Label l) = sourcenode a[THEN sym] wf
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have [simp]:"n = Label l" by fastforce
    from prog  Label l -CEdge (p, es, rets)p n' have "n'  Exit"
      by(fastforce dest:Proc_CFG_Call_Labels)
    with prog  Label l -CEdge (p, es, rets)p n'
    have "while (b) prog  Label l  2 -CEdge (p, es, rets)p 
      n'  2" by -(rule Proc_CFG_edge_WhileBody_source_not_Entry,auto)
    with (p, ins, outs, c)  set procs
    have "while (b) prog,procs  (Main,Label l  2) 
      -(λs. True):(Main,n'  2)pmap (λe cf. interpret e cf) es (p,Entry)"
      by(fastforce intro:PCFG.MainCall)
    thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
  next
    case (ProcCall p ins outs c l p' es' rets' l' ins' outs' c')
    from (p, Label l) = sourcenode a[THEN sym]
      (p', Entry) = targetnode a[THEN sym]  ‹well_formed procs
      (p, ins, outs, c)  set procs (p', ins', outs', c')  set procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  next
    case (MainReturn l p es rets l' ins outs c)
    from (p, ins, outs, c)  set procs (p, Exit) = sourcenode a[THEN sym]
      (Main, Label l') = targetnode a[THEN sym] wf
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have [simp]:"n = Label l'" by fastforce
    from prog  Label l -CEdge (p, es, rets)p Label l'
    have "while (b) prog  Label l  2 -CEdge (p, es, rets)p 
      Label l'  2" by -(rule Proc_CFG_edge_WhileBody_source_not_Entry,auto)
    with (p, ins, outs, c)  set procs
    have "while (b) prog,procs  (p,Exit) -(λcf. snd cf = (Main,Label l'  2))p
      (λcf cf'. cf'(rets [:=] map cf outs)) (Main,Label l'  2)"
      by(fastforce intro:PCFG.MainReturn)
    thus ?case by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
  next
    case (ProcReturn p ins outs c l p' es' rets' l' ins' outs' c' ps)
    from (p', Exit) = sourcenode a[THEN sym] 
      (p, Label l') = targetnode a[THEN sym] ‹well_formed procs
      (p, ins, outs, c)  set procs (p', ins', outs', c')  set procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  next
    case (MainCallReturn nx p es rets nx')
    from (Main,n) = sourcenode a  (Main,n) = targetnode a show ?case
    proof
      assume "(Main,n) = sourcenode a"
      with (Main, nx) = sourcenode a[THEN sym] have [simp]:"nx = n" by simp
      from prog  nx -CEdge (p, es, rets)p nx' have "nx'  Exit"
        by(fastforce dest:Proc_CFG_Call_Labels)
      with n  Entry› prog  nx -CEdge (p, es, rets)p nx'
      have "while (b) prog  n  2 -CEdge (p, es, rets)p 
        nx'  2" by(fastforce intro:Proc_CFG_edge_WhileBody_source_not_Entry)
      hence "while (b) prog,procs  (Main,n  2) -(λs. False) (Main,nx'  2)"
        by -(rule PCFG.MainCallReturn)
      thus ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
    next
      assume "(Main, n) = targetnode a"
      from prog  nx -CEdge (p, es, rets)p nx'
      have "nx  Entry" and "nx'  Exit" by(auto dest:Proc_CFG_Call_Labels)
      with prog  nx -CEdge (p, es, rets)p nx'
      have "while (b) prog  nx  2 -CEdge (p, es, rets)p 
        nx'  2" by(fastforce intro:Proc_CFG_edge_WhileBody_source_not_Entry)
      hence "while (b) prog,procs  (Main,nx  2) -(λs. False) (Main,nx'  2)"
        by -(rule PCFG.MainCallReturn)
      with (Main, n) = targetnode a (Main, nx') = targetnode a[THEN sym] 
      show ?thesis by(simp add:ProcCFG.valid_node_def)(fastforce simp:valid_edge_def)
    qed
  next
    case (ProcCallReturn p ins outs c nx p' es' rets' n' ps)
    from (p, nx) = sourcenode a[THEN sym] (p, n') = targetnode a[THEN sym]
      (p, ins, outs, c)  set procs ‹well_formed procs
      (Main, n) = sourcenode a  (Main, n) = targetnode a
    have False by fastforce
    thus ?case by simp
  qed
qed


lemma path_Main_WhileBody:
  assumes "Rep_wf_prog wfp = (prog,procs)" 
  and "Rep_wf_prog wfp' = (while (b) prog,procs)"
  shows "wfp  (Main,n) -as→* (p',n'); a  set as. intra_kind (kind a); 
    n  Entry; n'  Exit  wfp'  (Main,n  2) -as ⊕s 2→* (p',n'  2)"
proof(induct "(Main,n)" as "(p',n')" arbitrary:n rule:ProcCFG.path.induct)
  case empty_path
  from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp) (Main, n')
    n'  Entry› ‹Rep_wf_prog wfp = (prog,procs)
    ‹Rep_wf_prog wfp' = (while (b) prog,procs)
  have "CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n'  2)" 
    by(fastforce intro:valid_node_Main_WhileBody)
  with ‹Main = p' show ?case
    by(fastforce intro:ProcCFG.empty_path simp:label_incrs_def)
next
  case (Cons_path n'' as a n)
  note IH = n.  n'' = (Main, n); aset as. intra_kind (kind a); n  Entry; 
    n'  Exit  wfp'  (Main, n  2) -as ⊕s 2→* (p', n'  2)
  note [simp] = ‹Rep_wf_prog wfp = (prog,procs) 
     ‹Rep_wf_prog wfp' = (while (b) prog,procs)
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  from aset (a # as). intra_kind (kind a) have "intra_kind (kind a)"
    and "aset as. intra_kind (kind a)" by simp_all
  from ‹valid_edge wfp a ‹sourcenode a = (Main, n) ‹targetnode a = n''
    ‹intra_kind (kind a) wf 
  obtain nx'' where "n'' = (Main,nx'')" and "nx''  Entry"
    by(auto elim!:PCFG.cases simp:valid_edge_def intra_kind_def)
  from IH[OF n'' = (Main,nx'') aset as. intra_kind (kind a) 
    nx''  Entry› n'  Exit›]
  have path:"wfp'  (Main, nx''  2) -as ⊕s 2→* (p', n'  2)" .
  with n'  Exit› have "nx''  Exit" by(fastforce dest:ProcCFGExit.path_Exit_source)
  with ‹valid_edge wfp a ‹sourcenode a = (Main, n) ‹targetnode a = n''
    n'' = (Main,nx'') n  Entry› ‹intra_kind (kind a) wf
  have "while (b) prog,procs  (Main, n  2) -kind a (Main, nx''  2)"
    by(fastforce intro:PCFG_Main_edge_WhileBody_source_not_Entry simp:valid_edge_def)
  with path ‹sourcenode a = (Main, n) ‹targetnode a = n'' n'' = (Main,nx'')
  show ?case
    apply(cases a) apply(clarsimp simp:label_incrs_def)
    by(auto intro:ProcCFG.Cons_path simp:valid_edge_def)
qed


subsubsection ‹Existence of intraprodecural paths›

lemma Label_Proc_CFG_Entry_Exit_path_Main:
  assumes "Rep_wf_prog wfp = (prog,procs)" and "l < #:prog"
  obtains as as' where "wfp  (Main,Label l) -as→* (Main,Exit)"
  and "a  set as. intra_kind (kind a)"
  and "wfp  (Main,Entry) -as'→* (Main,Label l)"
  and "a  set as'. intra_kind (kind a)"
proof(atomize_elim)
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  from l < #:prog ‹Rep_wf_prog wfp = (prog,procs)
  show "as as'. wfp  (Main, Label l) -as→* (Main, Exit) 
    (aset as. intra_kind (kind a)) 
    wfp  (Main, Entry) -as'→* (Main, Label l)  (aset as'. intra_kind (kind a))"
  proof(induct prog arbitrary:l wfp)
    case Skip
    note [simp] = ‹Rep_wf_prog wfp = (Skip, procs)
    from l < #:Skip› have [simp]:"l = 0" by simp
    have "wfp  (Main,Entry) -[((Main,Entry),(λs. True),(Main,Label 0))]→* 
      (Main,Label 0)" 
      by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_Entry
                   simp:valid_edge_def ProcCFG.valid_node_def)
    moreover
    have "wfp  (Main,Label l) -[((Main,Label l),id,(Main,Exit))]→* (Main,Exit)" 
      by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_Skip simp:valid_edge_def)
    ultimately show ?case by(fastforce simp:intra_kind_def)
  next
    case (LAss V e)
    note [simp] = ‹Rep_wf_prog wfp = (V:=e, procs)
    from l < #:V:=e have "l = 0  l = 1" by auto
    thus ?case
    proof
      assume [simp]:"l = 0"
      have "wfp  (Main,Entry) -[((Main,Entry),(λs. True),(Main,Label 0))]→*
        (Main,Label 0)" 
        by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_Entry
                    simp:valid_edge_def ProcCFG.valid_node_def)
      moreover
      have "wfp  (Main,Label 0) 
        -((Main,Label 0),(λcf. update cf V e),(Main,Label 1))#
        [((Main,Label 1),id,(Main,Exit))]→* (Main,Exit)"
        by(fastforce intro:ProcCFG.Cons_path ProcCFG.path.intros Main Proc_CFG_LAss 
          Proc_CFG_LAssSkip simp:valid_edge_def ProcCFG.valid_node_def)
      ultimately show ?thesis by(fastforce simp:intra_kind_def)
    next
      assume [simp]:"l = 1"
      have "wfp  (Main,Entry) -((Main,Entry),(λs. True),(Main,Label 0))#
        [((Main,Label 0),(λcf. update cf V e),(Main,Label 1))]→* (Main,Label 1)"
        by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_LAss ProcCFG.Cons_path 
          Main Proc_CFG_Entry simp:ProcCFG.valid_node_def valid_edge_def)
      moreover
      have "wfp  (Main,Label 1) -[((Main,Label 1),id,(Main,Exit))]→* 
        (Main,Exit)" by(fastforce intro:ProcCFG.path.intros  Main Proc_CFG_LAssSkip
        simp:valid_edge_def ProcCFG.valid_node_def)
      ultimately show ?thesis by(fastforce simp:intra_kind_def)
    qed
  next
    case (Seq c1 c2)
    note IH1 = l wfp. l < #:c1; Rep_wf_prog wfp = (c1, procs) 
      as as'. wfp  (Main, Label l) -as→* (Main, Exit)  
      (aset as. intra_kind (kind a)) 
      wfp  (Main, Entry) -as'→* (Main, Label l)  (aset as'. intra_kind (kind a))
    note IH2 = l wfp. l < #:c2; Rep_wf_prog wfp = (c2, procs) 
      as as'. wfp  (Main, Label l) -as→* (Main, Exit)  
      (aset as. intra_kind (kind a)) 
      wfp  (Main, Entry) -as'→* (Main, Label l)  (aset as'. intra_kind (kind a))
    note [simp] = ‹Rep_wf_prog wfp = (c1;; c2, procs)
    show ?case
    proof(cases "l < #:c1")
      case True
      from ‹Rep_wf_prog wfp = (c1;; c2, procs)
      obtain wfp' where [simp]:"Rep_wf_prog wfp' = (c1, procs)" by(erule wfp_Seq1)
      from IH1[OF True this] obtain as as' 
        where path1:"wfp'  (Main, Label l) -as→* (Main, Exit)"
        and intra1:"aset as. intra_kind (kind a)"
        and path2:"wfp'  (Main, Entry) -as'→* (Main, Label l)"
        and intra2:"aset as'. intra_kind (kind a)" by blast
      from path1 have "as  []" by(fastforce elim:ProcCFG.path.cases)
      then obtain ax asx where [simp]:"as = asx@[ax]"
        by(cases as rule:rev_cases) fastforce+
      with path1 have "wfp'  (Main, Label l) -asx→* sourcenode ax"
        and "valid_edge wfp' ax" and "targetnode ax = (Main, Exit)"
        by(auto elim:ProcCFG.path_split_snoc)
      from ‹valid_edge wfp' ax ‹targetnode ax = (Main, Exit)
      obtain nx where "sourcenode ax = (Main,nx)" 
        by(fastforce elim:PCFG.cases simp:valid_edge_def)
      with wfp'  (Main, Label l) -asx→* sourcenode ax have "nx  Entry"
        by fastforce
      moreover
      from ‹valid_edge wfp' ax ‹sourcenode ax = (Main,nx) have "nx  Exit"
        by(fastforce intro:ProcCFGExit.Exit_source)
      ultimately obtain lx where [simp]:"nx = Label lx" by(cases nx) auto
      with wfp'  (Main, Label l) -asx→* sourcenode ax 
        ‹sourcenode ax = (Main,nx) intra1
      have path3:"wfp  (Main, Label l) -asx→* (Main, Label lx)"
        by -(rule path_SeqFirst,auto)
      from ‹valid_edge wfp' ax ‹targetnode ax = (Main, Exit)
        ‹sourcenode ax = (Main,nx) wf
      obtain etx where "c1  Label lx -etxp Exit" 
        by(fastforce elim!:PCFG.cases simp:valid_edge_def)
      then obtain et where [simp]:"etx = IEdge et" 
        by(cases etx)(auto dest:Proc_CFG_Call_Labels)
      with c1  Label lx -etxp Exit› have "intra_kind et"
        by(fastforce intro:Proc_CFG_IEdge_intra_kind)
      from c1  Label lx -etxp Exit› path3
      have path4:"wfp  (Main, Label l) -asx@
        [((Main, Label lx),et,(Main,Label 0  #:c1))] →* (Main,Label 0  #:c1)"
        by(fastforce intro:ProcCFG.path_Append ProcCFG.path.intros Proc_CFG_SeqConnect
          Main simp:ProcCFG.valid_node_def valid_edge_def)
      from ‹Rep_wf_prog wfp = (c1;; c2, procs)
      obtain wfp'' where [simp]:"Rep_wf_prog wfp'' = (c2, procs)" by(erule wfp_Seq2)
      from IH2[OF _ this,of "0"] obtain asx' 
        where "wfp''  (Main, Label 0) -asx'→* (Main, Exit)"
        and "aset asx'. intra_kind (kind a)" by blast
      with path4 intra1 ‹intra_kind et have "wfp  (Main, Label l) 
        -(asx@[((Main, Label lx),et,(Main,Label 0  #:c1))])@(asx' ⊕s #:c1)→*
        (Main, Exit  #:c1)"
        by -(erule ProcCFG.path_Append,rule path_Main_SeqSecond,auto)
      moreover
      from intra1 ‹intra_kind et aset asx'. intra_kind (kind a)
      have "a  set ((asx@[((Main, Label lx),et,(Main,Label #:c1))])@(asx' ⊕s #:c1)).
        intra_kind (kind a)" by(auto simp:label_incrs_def)
      moreover
      from path2 intra2 have "wfp  (Main, Entry) -as'→* (Main, Label l)"
        by -(rule path_SeqFirst,auto)
      ultimately show ?thesis using aset as'. intra_kind (kind a) by fastforce
    next
      case False
      hence "#:c1  l" by simp
      then obtain l' where [simp]:"l = l' + #:c1" and "l' = l - #:c1" by simp
      from l < #:c1;; c2 have "l' < #:c2" by simp
      from ‹Rep_wf_prog wfp = (c1;; c2, procs)
      obtain wfp' where [simp]:"Rep_wf_prog wfp' = (c2, procs)" by(erule wfp_Seq2)
      from IH2[OF l' < #:c2 this] obtain as as' 
        where path1:"wfp'  (Main, Label l') -as→* (Main, Exit)"
        and intra1:"aset as. intra_kind (kind a)"
        and path2:"wfp'  (Main, Entry) -as'→* (Main, Label l')"
        and intra2:"aset as'. intra_kind (kind a)" by blast
      from path1 intra1
      have "wfp  (Main, Label l'  #:c1) -as ⊕s #:c1→* (Main, Exit  #:c1)"
        by -(rule path_Main_SeqSecond,auto)
      moreover
      from path2 have "as'  []" by(fastforce elim:ProcCFG.path.cases)
      with path2 obtain ax' asx' where [simp]:"as' = ax'#asx'"
        and "sourcenode ax' = (Main, Entry)" and "valid_edge wfp' ax'" 
        and "wfp'  targetnode ax' -asx'→* (Main, Label l')"
        by -(erule ProcCFG.path_split_Cons,fastforce+)
      from wfp'  targetnode ax' -asx'→* (Main, Label l')
      have "targetnode ax'  (Main,Exit)" by fastforce
      with ‹valid_edge wfp' ax' ‹sourcenode ax' = (Main, Entry) wf
      have "targetnode ax' = (Main,Label 0)"
        by(fastforce elim:PCFG.cases dest:Proc_CFG_EntryD simp:valid_edge_def)
      with wfp'  targetnode ax' -asx'→* (Main, Label l') intra2
      have path3:"wfp  (Main,Label 0  #:c1) -asx' ⊕s #:c1→* 
        (Main, Label l'  #:c1)" by -(rule path_Main_SeqSecond,auto)
      from ‹Rep_wf_prog wfp = (c1;; c2, procs)
      obtain wfp'' where [simp]:"Rep_wf_prog wfp'' = (c1, procs)" by(erule wfp_Seq1)
      from IH1[OF _ this,of "0"] obtain xs 
        where "wfp''  (Main, Label 0) -xs→* (Main, Exit)"
        and "aset xs. intra_kind (kind a)" by blast
      from wfp''  (Main, Label 0) -xs→* (Main, Exit) have "xs  []"
        by(fastforce elim:ProcCFG.path.cases)
      then obtain x xs' where [simp]:"xs = xs'@[x]"
        by(cases xs rule:rev_cases) fastforce+
      with wfp''  (Main, Label 0) -xs→* (Main, Exit)
      have "wfp''  (Main, Label 0) -xs'→* sourcenode x"
        and "valid_edge wfp'' x" and "targetnode x = (Main, Exit)"
        by(auto elim:ProcCFG.path_split_snoc)
      from ‹valid_edge wfp'' x ‹targetnode x = (Main, Exit)
      obtain nx where "sourcenode x = (Main,nx)" 
        by(fastforce elim:PCFG.cases simp:valid_edge_def)
      with wfp''  (Main, Label 0) -xs'→* sourcenode x have "nx  Entry"
        by fastforce
      from ‹valid_edge wfp'' x ‹sourcenode x = (Main,nx) have "nx  Exit"
        by(fastforce intro:ProcCFGExit.Exit_source)
      with nx  Entry› obtain lx where [simp]:"nx = Label lx" by(cases nx) auto
      from wfp''  (Main, Label 0) -xs'→* sourcenode x 
        ‹sourcenode x = (Main,nx) aset xs. intra_kind (kind a)
      have "wfp  (Main, Entry) 
        -((Main, Entry),(λs. True),(Main, Label 0))#xs'→* sourcenode x"
        apply simp apply(rule path_SeqFirst[OF ‹Rep_wf_prog wfp'' = (c1, procs)])
        apply(auto intro!:ProcCFG.Cons_path)
        by(auto intro:Main Proc_CFG_Entry simp:valid_edge_def intra_kind_def)
      with ‹valid_edge wfp'' x ‹targetnode x = (Main, Exit) path3
        ‹sourcenode x = (Main,nx) nx  Entry› ‹sourcenode x = (Main,nx) wf
      have "wfp  (Main, Entry) -((((Main, Entry),(λs. True),(Main, Label 0))#xs')@
        [(sourcenode x,kind x,(Main,Label #:c1))])@(asx' ⊕s #:c1)→* 
        (Main, Label l'  #:c1)" 
        by(fastforce intro:ProcCFG.path_Append ProcCFG.path.intros Main 
          Proc_CFG_SeqConnect elim!:PCFG.cases dest:Proc_CFG_Call_Labels
          simp:ProcCFG.valid_node_def valid_edge_def)
      ultimately show ?thesis using intra1 intra2 aset xs. intra_kind (kind a)
        by(fastforce simp:label_incrs_def intra_kind_def)
    qed
  next
    case (Cond b c1 c2)
    note IH1 = l wfp. l < #:c1; Rep_wf_prog wfp = (c1, procs) 
      as as'. wfp  (Main, Label l) -as→* (Main, Exit)  
      (aset as. intra_kind (kind a)) 
      wfp  (Main, Entry) -as'→* (Main, Label l)  (aset as'. intra_kind (kind a))
    note IH2 = l wfp. l < #:c2; Rep_wf_prog wfp = (c2, procs) 
      as as'. wfp  (Main, Label l) -as→* (Main, Exit)  
      (aset as. intra_kind (kind a)) 
      wfp  (Main, Entry) -as'→* (Main, Label l)  (aset as'. intra_kind (kind a))
    note [simp] = ‹Rep_wf_prog wfp = (if (b) c1 else c2, procs)
    show ?case
    proof(cases "l = 0")
      case True
      from ‹Rep_wf_prog wfp = (if (b) c1 else c2, procs)
      obtain wfp' where [simp]:"Rep_wf_prog wfp' = (c1, procs)" by(erule wfp_CondTrue)
      from IH1[OF _ this,of 0] obtain as 
        where path:"wfp'  (Main, Label 0) -as→* (Main, Exit)"
        and intra:"aset as. intra_kind (kind a)" by blast
      have "if (b) c1 else c2,procs  (Main,Label 0)
        -(λcf. state_check cf b (Some true)) (Main,Label 0  1)"
        by(fastforce intro:Main Proc_CFG_CondTrue)
      with path intra have "wfp  (Main,Label 0)
        -[((Main,Label 0),(λcf. state_check cf b (Some true)),(Main,Label 0  1))]@
        (as ⊕s 1)→* (Main,Exit  1)"
        apply - apply(rule ProcCFG.path_Append) apply(rule ProcCFG.path.intros)+
        prefer 5 apply(rule path_Main_CondTrue)
        apply(auto intro:ProcCFG.path.intros simp:valid_edge_def)
        by(fastforce simp:ProcCFG.valid_node_def valid_edge_def)
      moreover
      have "if (b) c1 else c2,procs  (Main,Entry) -(λs. True) 
        (Main,Label 0)" by(fastforce intro:Main Proc_CFG_Entry)
      hence "wfp  (Main,Entry) -[((Main,Entry),(λs. True),(Main,Label 0))]→* 
        (Main,Label 0)"
        by(fastforce intro:ProcCFG.path.intros 
                    simp:ProcCFG.valid_node_def valid_edge_def)
      ultimately show ?thesis using l = 0 aset as. intra_kind (kind a) 
        by(fastforce simp:label_incrs_def intra_kind_def)
    next
      case False
      hence "0 < l" by simp
      then obtain l' where [simp]:"l = l' + 1" and "l' = l - 1" by simp
      show ?thesis
      proof(cases "l' < #:c1")
        case True
        from ‹Rep_wf_prog wfp = (if (b) c1 else c2, procs)
        obtain wfp' where [simp]:"Rep_wf_prog wfp' = (c1, procs)" 
          by(erule wfp_CondTrue)
        from IH1[OF True this] obtain as as' 
          where path1:"wfp'  (Main, Label l') -as→* (Main, Exit)"
          and intra1:"aset as. intra_kind (kind a)"
          and path2:"wfp'  (Main, Entry) -as'→* (Main, Label l')"
          and intra2:"aset as'. intra_kind (kind a)" by blast
        from path1 intra1
        have "wfp  (Main, Label l'  1) -as ⊕s 1→* (Main, Exit  1)"
          by -(rule path_Main_CondTrue,auto)
        moreover
        from path2 obtain ax' asx' where [simp]:"as' = ax'#asx'"
          and "sourcenode ax' = (Main,Entry)" and "valid_edge wfp' ax'"
          and "wfp'  targetnode ax' -asx'→* (Main, Label l')"
          by -(erule ProcCFG.path.cases,fastforce+)
        with wf have "targetnode ax' = (Main,Label 0)"
          by(fastforce elim:PCFG.cases dest:Proc_CFG_EntryD Proc_CFG_Call_Labels 
                      simp:valid_edge_def)
        with wfp'  targetnode ax' -asx'→* (Main, Label l') intra2
        have "wfp  (Main,Entry) -((Main,Entry),(λs. True),(Main,Label 0))#
          ((Main,Label 0),(λcf. state_check cf b (Some true)),(Main,Label 0  1))#
          (asx' ⊕s 1)→* (Main,Label l'  1)"
          apply - apply(rule ProcCFG.path.intros)+ apply(rule path_Main_CondTrue) 
          by(auto intro:Main Proc_CFG_Entry Proc_CFG_CondTrue simp:valid_edge_def)
        ultimately show ?thesis using intra1 intra2
          by(fastforce simp:label_incrs_def intra_kind_def)
      next
        case False
        hence "#:c1  l'" by simp
        then obtain l'' where [simp]:"l' = l'' + #:c1" and "l'' = l' - #:c1" by simp
        from  l < #:(if (b) c1 else c2) have "l'' < #:c2" by simp
        from ‹Rep_wf_prog wfp = (if (b) c1 else c2, procs)
        obtain wfp'' where [simp]:"Rep_wf_prog wfp'' = (c2, procs)" 
          by(erule wfp_CondFalse)
        from IH2[OF l'' < #:c2 this] obtain as as' 
          where path1:"wfp''  (Main, Label l'') -as→* (Main, Exit)"
          and intra1:"aset as. intra_kind (kind a)"
          and path2:"wfp''  (Main, Entry) -as'→* (Main, Label l'')"
          and intra2:"aset as'. intra_kind (kind a)" by blast
        from path1 intra1
        have "wfp  (Main, Label l''  (#:c1 + 1)) -as ⊕s (#:c1 + 1)→* 
          (Main, Exit  (#:c1 + 1))"
          by -(rule path_Main_CondFalse,auto simp:add.assoc)
        moreover
        from path2 obtain ax' asx' where [simp]:"as' = ax'#asx'"
          and "sourcenode ax' = (Main,Entry)" and "valid_edge wfp'' ax'"
          and "wfp''  targetnode ax' -asx'→* (Main, Label l'')"
          by -(erule ProcCFG.path.cases,fastforce+)
        with wf have "targetnode ax' = (Main,Label 0)"
          by(fastforce elim:PCFG.cases dest:Proc_CFG_EntryD Proc_CFG_Call_Labels 
                      simp:valid_edge_def)
        with wfp''  targetnode ax' -asx'→* (Main, Label l'') intra2
        have "wfp  (Main,Entry) -((Main,Entry),(λs. True),(Main,Label 0))#
          ((Main,Label 0),(λcf. state_check cf b (Some false)),
          (Main,Label (#:c1 + 1)))#(asx' ⊕s (#:c1 + 1))→* 
          (Main,Label l''  (#:c1 + 1))"
          apply - apply(rule ProcCFG.path.intros)+ apply(rule path_Main_CondFalse)
          by(auto intro:Main Proc_CFG_Entry Proc_CFG_CondFalse simp:valid_edge_def)
        ultimately show ?thesis using intra1 intra2
          by(fastforce simp:label_incrs_def intra_kind_def add.assoc)
      qed
    qed
  next
    case (While b c')
    note IH = l wfp. l < #:c'; Rep_wf_prog wfp = (c', procs) 
      as as'. wfp  (Main, Label l) -as→* (Main, Exit) 
      (aset as. intra_kind (kind a)) 
      wfp  (Main, Entry) -as'→* (Main, Label l)  (aset as'. intra_kind (kind a))
    note [simp] = ‹Rep_wf_prog wfp = (while (b) c', procs)
    show ?case
    proof(cases "l = 0")
      case True
      hence "wfp  (Main,Label l) - 
        ((Main,Label 0),(λcf. state_check cf b (Some false)),(Main,Label 1))#
        [((Main,Label 1),id,(Main,Exit))]→* (Main,Exit)"
        by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_WhileFalseSkip 
          Proc_CFG_WhileFalse simp:valid_edge_def)
      moreover
      have "while (b) c'  Entry -IEdge (λs. True)p Label 0" by(rule Proc_CFG_Entry)
      with l = 0 have "wfp  (Main,Entry) 
        -[((Main,Entry),(λs. True),(Main,Label 0))]→* (Main,Label l)"
        by(fastforce intro:ProcCFG.path.intros Main 
                     simp:ProcCFG.valid_node_def valid_edge_def)
      ultimately show ?thesis by(fastforce simp:intra_kind_def)
    next
      case False
      hence "1  l" by simp
      thus ?thesis
      proof(cases "l < 2")
        case True
        with 1  l have [simp]:"l = 1" by simp
        have "wfp  (Main,Label l) -[((Main,Label 1),id,(Main,Exit))]→* (Main,Exit)"
          by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_WhileFalseSkip 
                      simp:valid_edge_def)
        moreover
        have "while (b) c'  Label 0 -IEdge (λcf. state_check cf b (Some false))p 
          Label 1" by(rule Proc_CFG_WhileFalse)
        hence "wfp  (Main,Entry) -((Main,Entry),(λs. True),(Main,Label 0))#
          [((Main,Label 0),(λcf. state_check cf b (Some false)),(Main,Label 1))]→*
          (Main,Label l)"
          by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_Entry 
                       simp:ProcCFG.valid_node_def valid_edge_def)
        ultimately show ?thesis by(fastforce simp:intra_kind_def)
      next
        case False
        with 1  l have "2  l" by simp
        then obtain l' where [simp]:"l = l' + 2" and "l' = l - 2" 
          by(simp del:add_2_eq_Suc')
        from l < #:while (b) c' have "l' < #:c'" by simp
        from ‹Rep_wf_prog wfp = (while (b) c', procs)
        obtain wfp' where [simp]:"Rep_wf_prog wfp' = (c', procs)" 
          by(erule wfp_WhileBody)
        from IH[OF l' < #:c' this] obtain as as' 
          where path1:"wfp'  (Main, Label l') -as→* (Main, Exit)"
          and intra1:"aset as. intra_kind (kind a)"
          and path2:"wfp'  (Main, Entry) -as'→* (Main, Label l')"
          and intra2:"aset as'. intra_kind (kind a)" by blast
        from path1 have "as  []" by(fastforce elim:ProcCFG.path.cases)
        with path1 obtain ax asx where [simp]:"as = asx@[ax]"
          and "wfp'  (Main, Label l') -asx→* sourcenode ax"
          and "valid_edge wfp' ax" and "targetnode ax = (Main, Exit)"
          by -(erule ProcCFG.path_split_snoc,fastforce+)
        with wf obtain lx etx where "sourcenode ax = (Main,Label lx)"
          and "intra_kind (kind ax)"
          apply(auto elim!:PCFG.cases dest:Proc_CFG_Call_Labels simp:valid_edge_def)
          by(case_tac n)(auto dest:Proc_CFG_IEdge_intra_kind)
        with wfp'  (Main, Label l') -asx→* sourcenode ax intra1
        have "wfp  (Main, Label l'  2) -asx ⊕s 2→* (Main,Label lx  2)"
          by -(rule path_Main_WhileBody,auto)
        from ‹valid_edge wfp' ax ‹sourcenode ax = (Main,Label lx)
          ‹targetnode ax = (Main, Exit) ‹intra_kind (kind ax) wf
        have "while (b) c',procs  (Main,Label lx  2) -kind ax 
          (Main,Label 0)"
          by(fastforce intro!:Main Proc_CFG_WhileBodyExit elim!:PCFG.cases 
                        dest:Proc_CFG_Call_Labels simp:valid_edge_def)
        hence "wfp  (Main,Label lx  2) 
          -((Main,Label lx  2),kind ax,(Main,Label 0))#
          ((Main,Label 0),(λcf. state_check cf b (Some false)),(Main,Label 1))#
          [((Main,Label 1),id,(Main,Exit))]→* (Main,Exit)"
          by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_WhileFalse 
            Proc_CFG_WhileFalseSkip simp:valid_edge_def)
        with wfp  (Main, Label l'  2) -asx ⊕s 2→* (Main,Label lx  2)
        have "wfp  (Main, Label l) -(asx ⊕s 2)@
          (((Main,Label lx  2),kind ax,(Main,Label 0))#
          ((Main,Label 0),(λcf. state_check cf b (Some false)),(Main,Label 1))#
          [((Main,Label 1),id,(Main,Exit))])→* (Main,Exit)"
          by(fastforce intro:ProcCFG.path_Append)
        moreover
        from path2 have "as'  []" by(fastforce elim:ProcCFG.path.cases)
        with path2 obtain ax' asx' where [simp]:"as' = ax'#asx'"
          and "wfp'  targetnode ax' -asx'→* (Main,Label l')"
          and "valid_edge wfp' ax'" and "sourcenode ax' = (Main, Entry)"
          by -(erule ProcCFG.path_split_Cons,fastforce+)
        with wf have "targetnode ax' = (Main,Label 0)" and "intra_kind (kind ax')"
          by(fastforce elim!:PCFG.cases dest:Proc_CFG_Call_Labels 
            Proc_CFG_EntryD simp:intra_kind_def valid_edge_def)+
        with wfp'  targetnode ax' -asx'→* (Main,Label l') intra2
        have "wfp  (Main, Label 0  2) -asx' ⊕s 2→* (Main,Label l'  2)"
          by -(rule path_Main_WhileBody,auto simp del:add_2_eq_Suc')
        hence "wfp  (Main,Entry) -((Main,Entry),(λs. True),(Main,Label 0))#
          ((Main,Label 0),(λcf. state_check cf b (Some true)),(Main,Label 2))#
          (asx' ⊕s 2)→* (Main,Label l)"
          by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_WhileTrue 
            Proc_CFG_Entry simp:valid_edge_def)
        ultimately show ?thesis using ‹intra_kind (kind ax) intra1 intra2
          by(fastforce simp:label_incrs_def intra_kind_def)
      qed
    qed
  next
    case (Call p es rets)
    note Rep [simp] = ‹Rep_wf_prog wfp = (Call p es rets, procs)
    have cC:"containsCall procs (Call p es rets) [] p" by simp
    show ?case
    proof(cases "l = 0")
      case True
      have "wfp  (Main,Label 0) -((Main,Label 0),(λs. False),(Main,Label 1))#
        [((Main,Label 1),id,(Main,Exit))]→* (Main,Exit)"
        by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_CallSkip MainCallReturn
          Proc_CFG_Call simp:valid_edge_def)
      moreover
      have "Call p es rets,procs  (Main,Entry) -(λs. True) (Main,Label 0)"
        by(fastforce intro:Main Proc_CFG_Entry)
      hence "wfp  (Main,Entry) -[((Main,Entry),(λs. True),(Main,Label 0))]→*
        (Main,Label 0)"
        by(fastforce intro:ProcCFG.path.intros 
          simp:ProcCFG.valid_node_def valid_edge_def)
      ultimately show ?thesis using l = 0 by(fastforce simp:intra_kind_def)
    next
      case False
      with l < #:Call p es rets have "l = 1" by simp
      have "wfp  (Main,Label 1) -[((Main,Label 1),id,(Main,Exit))]→* (Main,Exit)"
        by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_CallSkip
                    simp:valid_edge_def)
      moreover
      have "Call p es rets,procs  (Main,Label 0) -(λs. False) (Main,Label 1)"
        by(fastforce intro:MainCallReturn Proc_CFG_Call)
      hence "wfp  (Main,Entry) -((Main,Entry),(λs. True),(Main,Label 0))#
        [((Main,Label 0),(λs. False),(Main,Label 1))]→* (Main,Label 1)"
        by(fastforce intro:ProcCFG.path.intros Main Proc_CFG_Entry 
                    simp:ProcCFG.valid_node_def valid_edge_def)
      ultimately show ?thesis using l = 1 by(fastforce simp:intra_kind_def)
    qed
  qed
qed



subsection ‹Lifting from edges in procedure Main to arbitrary procedures›

lemma lift_edge_Main_Main:
  "c,procs  (Main, n) -et (Main, n'); (p,ins,outs,c)  set procs;
  containsCall procs prog ps p; well_formed procs 
   prog,procs  (p, n) -et (p, n')"
proof(induct "(Main,n)" et "(Main,n')" rule:PCFG.induct)
  case Main thus ?case by(fastforce intro:Proc)
next
  case MainCallReturn thus ?case by(fastforce intro:ProcCallReturn)
qed auto

lemma lift_edge_Main_Proc:
  "c,procs  (Main, n) -et (q, n'); q  Main; (p,ins,outs,c)  set procs;
  containsCall procs prog ps p; well_formed procs 
   et'. prog,procs  (p, n) -et' (q, n')"
proof(induct "(Main,n)" et "(q,n')" rule:PCFG.induct)
  case (MainCall l esx retsx n'x insx outsx cx)
  from c  Label l -CEdge (q, esx, retsx)p n'x 
  obtain l' where [simp]:"n'x = Label l'" by(fastforce dest:Proc_CFG_Call_Labels)
  with MainCall have "prog,procs  (p, n) 
    -(λs. True):(p,n'x)qmap (λe cf. interpret e cf) esx (q, n')"
    by(fastforce intro:ProcCall)
  thus ?case by fastforce
qed auto

lemma lift_edge_Proc_Main:
  "c,procs  (q, n) -et (Main, n'); q  Main; (p,ins,outs,c)  set procs;
  containsCall procs prog ps p; well_formed procs 
   et'. prog,procs  (q, n) -et' (p, n')"
proof(induct "(q,n)" et "(Main,n')" rule:PCFG.induct)
  case (MainReturn l esx retsx l' insx outsx cx)
  note [simp] = ‹Exit = n[THEN sym] ‹Label l' = n'[THEN sym]
  from MainReturn have "prog,procs  (q,Exit) -(λcf. snd cf = (p,Label l'))q
    (λcf cf'. cf'(retsx [:=] map cf outsx)) (p,Label l')"
    by(fastforce intro!:ProcReturn)
  thus ?case by fastforce
qed auto


fun lift_edge :: "edge  pname  edge"
where "lift_edge a p = ((p,snd(sourcenode a)),kind a,(p,snd(targetnode a)))"

fun lift_path :: "edge list  pname  edge list"
  where "lift_path as p = map (λa. lift_edge a p) as"


lemma lift_path_Proc: 
  assumes "Rep_wf_prog wfp' = (c,procs)" and "Rep_wf_prog wfp = (prog,procs)"
  and "(p,ins,outs,c)  set procs" and "containsCall procs prog ps p"
  shows "wfp'  (Main,n) -as→* (Main,n'); a  set as. intra_kind (kind a)
   wfp  (p,n) -lift_path as p→* (p,n')"
proof(induct "(Main,n)" as "(Main,n')" arbitrary:n rule:ProcCFG.path.induct)
  case empty_path
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  from ‹CFG.valid_node sourcenode targetnode (valid_edge wfp') (Main, n')
    assms wf
  have "CFG.valid_node sourcenode targetnode (valid_edge wfp) (p,n')"
    apply(auto simp:ProcCFG.valid_node_def valid_edge_def)
     apply(case_tac "ab = Main")
      apply(fastforce dest:lift_edge_Main_Main)
     apply(fastforce dest!:lift_edge_Main_Proc)
    apply(case_tac "a = Main")
     apply(fastforce dest:lift_edge_Main_Main)
    by(fastforce dest!:lift_edge_Proc_Main)
  thus ?case by(fastforce dest:ProcCFG.empty_path)
next
  case (Cons_path m'' as a n)
  note IH = n. m'' = (Main, n); aset as. intra_kind (kind a)
     wfp  (p, n) -lift_path as p→* (p, n')
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs" 
    by(fastforce intro:wf_wf_prog)
  from aset (a # as). intra_kind (kind a) have "intra_kind (kind a)"
    and "aset as. intra_kind (kind a)" by simp_all
  from ‹valid_edge wfp' a ‹intra_kind (kind a) ‹sourcenode a = (Main, n) 
    ‹targetnode a = m'' ‹Rep_wf_prog wfp' = (c,procs)
  obtain n'' where "m'' = (Main, n'')"
    by(fastforce elim:PCFG.cases simp:valid_edge_def intra_kind_def)
  with ‹valid_edge wfp' a ‹Rep_wf_prog wfp' = (c,procs)
    ‹sourcenode a = (Main, n) ‹targetnode a = m''
    (p,ins,outs,c)  set procs ‹containsCall procs prog ps p 
    ‹Rep_wf_prog wfp = (prog,procs) wf
  have "prog,procs  (p, n) -kind a (p, n'')"
    by(auto intro:lift_edge_Main_Main simp:valid_edge_def)  
  from IH[OF m'' = (Main, n'') aset as. intra_kind (kind a)]
  have "wfp  (p, n'') -lift_path as p→* (p, n')" .
  with prog,procs  (p, n) -kind a (p, n'') ‹Rep_wf_prog wfp = (prog,procs)
    ‹sourcenode a = (Main, n) ‹targetnode a = m'' m'' = (Main, n'')
  show ?case by simp (rule ProcCFG.Cons_path,auto simp:valid_edge_def)
qed


subsection ‹Existence of paths from Entry and to Exit›

lemma Label_Proc_CFG_Entry_Exit_path_Proc:
  assumes "Rep_wf_prog wfp = (prog,procs)" and "l < #:c"
  and "(p,ins,outs,c)  set procs" and "containsCall procs prog ps p"
  obtains as as' where "wfp  (p,Label l) -as→* (p,Exit)"
  and "a  set as. intra_kind (kind a)"
  and "wfp  (p,Entry) -as'→* (p,Label l)"
  and "a  set as'. intra_kind (kind a)"
proof(atomize_elim)
  from ‹Rep_wf_prog wfp = (prog,procs) (p,ins,outs,c)  set procs
    ‹containsCall procs prog ps p
  obtain wfp' where "Rep_wf_prog wfp' = (c,procs)" by(erule wfp_Call)
  from this l < #:c obtain as as' where "wfp'  (Main,Label l) -as→* (Main,Exit)"
    and "a  set as. intra_kind (kind a)"
    and "wfp'  (Main,Entry) -as'→* (Main,Label l)"
    and "a  set as'. intra_kind (kind a)" 
    by(erule Label_Proc_CFG_Entry_Exit_path_Main)
  from ‹Rep_wf_prog wfp' = (c,procs) ‹Rep_wf_prog wfp = (prog,procs)
    (p,ins,outs,c)  set procs ‹containsCall procs prog ps p
    wfp'  (Main,Label l) -as→* (Main,Exit) a  set as. intra_kind (kind a)
  have "wfp  (p,Label l) -lift_path as p→* (p,Exit)"
    by(fastforce intro:lift_path_Proc)
  moreover
  from ‹Rep_wf_prog wfp' = (c,procs) ‹Rep_wf_prog wfp = (prog,procs)
    (p,ins,outs,c)  set procs ‹containsCall procs prog ps p
    wfp'  (Main,Entry) -as'→* (Main,Label l) a  set as'. intra_kind (kind a)
  have "wfp  (p,Entry) -lift_path as' p→* (p,Label l)"
    by(fastforce intro:lift_path_Proc)
  moreover
  from a  set as. intra_kind (kind a) a  set as'. intra_kind (kind a)
  have "a  set (lift_path as p). intra_kind (kind a)"
    and "a  set (lift_path as' p). intra_kind (kind a)" by auto
  ultimately
  show "as as'. wfp  (p, Label l) -as→* (p, Exit) 
    (aset as. intra_kind (kind a))  wfp  (p, Entry) -as'→* (p, Label l) 
    (aset as'. intra_kind (kind a))" by fastforce
qed


lemma Entry_to_Entry_and_Exit_to_Exit: 
  assumes "Rep_wf_prog wfp = (prog,procs)"
  and "containsCall procs prog ps p" and "(p,ins,outs,c)  set procs"
  obtains as as' where "CFG.valid_path' sourcenode targetnode kind
      (valid_edge wfp) (get_return_edges wfp) (Main,Entry) as (p,Entry)"
  and "CFG.valid_path' sourcenode targetnode kind
      (valid_edge wfp) (get_return_edges wfp) (p,Exit) as' (Main,Exit)"
proof(atomize_elim)
  from ‹containsCall procs prog ps p (p,ins,outs,c)  set procs
  show "as as'. CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
    (get_return_edges wfp) (Main, Entry) as (p, Entry) 
    CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
    (get_return_edges wfp) (p, Exit) as' (Main, Exit)"
  proof(induct ps arbitrary:p ins outs c rule:rev_induct)
    case Nil
    from ‹containsCall procs prog [] p
    obtain lx es rets lx' where "prog  Label lx -CEdge (p,es,rets)p Label lx'"
      by(erule containsCall_empty_Proc_CFG_Call_edge)
    with (p, ins, outs, c)  set procs
    have "prog,procs  (Main,Label lx) -(λs. True):(Main,Label lx')p
      map (λe cf. interpret e cf) es  (p,Entry)" 
      and "prog,procs  (p,Exit) -(λcf. snd cf = (Main,Label lx'))p
      (λcf cf'. cf'(rets [:=] map cf outs)) (Main,Label lx')"
      by -(rule MainCall,assumption+,rule MainReturn)
    with ‹Rep_wf_prog wfp = (prog,procs)
    have "wfp  (Main,Label lx) -[((Main,Label lx),
      (λs. True):(Main,Label lx')pmap (λe cf. interpret e cf) es,(p,Entry))]→* 
      (p,Entry)"
      and "wfp  (p,Exit) -[((p,Exit),(λcf. snd cf = (Main,Label lx'))p
      (λcf cf'. cf'(rets [:=] map cf outs)),(Main,Label lx'))]→* (Main,Label lx')"
      by(fastforce intro:ProcCFG.path.intros 
        simp:ProcCFG.valid_node_def valid_edge_def)+
    moreover
    from prog  Label lx -CEdge (p,es,rets)p Label lx'
    have "lx < #:prog" and "lx' < #:prog"
      by(auto intro:Proc_CFG_sourcelabel_less_num_nodes 
                    Proc_CFG_targetlabel_less_num_nodes)
    from ‹Rep_wf_prog wfp = (prog,procs) lx < #:prog obtain as 
      where "wfp  (Main,Entry) -as→* (Main,Label lx)"
      and "a  set as. intra_kind (kind a)"
      by -(erule Label_Proc_CFG_Entry_Exit_path_Main)
    moreover
    from ‹Rep_wf_prog wfp = (prog,procs) lx' < #:prog obtain as' 
      where "wfp  (Main,Label lx') -as'→* (Main,Exit)"
      and "a  set as'. intra_kind (kind a)"
      by -(erule Label_Proc_CFG_Entry_Exit_path_Main)
    moreover
    from a  set as. intra_kind (kind a) 
    have "CFG.valid_path kind (get_return_edges wfp) 
      (as@[((Main,Label lx),(λs. True):(Main,Label lx')p
      map (λe cf. interpret e cf) es,(p,Entry))])"
      by(fastforce intro:ProcCFG.same_level_path_valid_path_Append 
        ProcCFG.intras_same_level_path simp:ProcCFG.valid_path_def)
    moreover
    from a  set as'. intra_kind (kind a) 
    have "CFG.valid_path kind (get_return_edges wfp) 
      ([((p,Exit),(λcf. snd cf = (Main,Label lx'))p
      (λcf cf'. cf'(rets [:=] map cf outs)),(Main,Label lx'))]@as')"
      by(fastforce intro:ProcCFG.valid_path_same_level_path_Append 
        ProcCFG.intras_same_level_path simp:ProcCFG.valid_path_def)
    ultimately show ?case by(fastforce intro:ProcCFG.path_Append simp:ProcCFG.vp_def)
  next
    case (snoc p' ps')
    note IH = p ins outs c. 
      containsCall procs prog ps' p; (p,ins,outs,c)  set procs
       as as'. CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
      (get_return_edges wfp) (Main, Entry) as (p, Entry) 
      CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
      (get_return_edges wfp) (p, Exit) as' (Main, Exit)
    from ‹containsCall procs prog (ps' @ [p']) p
    obtain ins' outs' c' where "(p',ins',outs',c')  set procs"
      and "containsCall procs c' [] p" 
      and "containsCall procs prog ps' p'" by(auto elim:containsCallE)
    from IH[OF ‹containsCall procs prog ps' p' (p',ins',outs',c')  set procs] 
    obtain as as' where pathE:"CFG.valid_path' sourcenode targetnode kind 
      (valid_edge wfp) (get_return_edges wfp) (Main, Entry) as (p', Entry)"
      and pathX:"CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
      (get_return_edges wfp) (p', Exit) as' (Main, Exit)" by blast
    from ‹containsCall procs c' [] p
    obtain lx es rets lx' where edge:"c'  Label lx -CEdge (p,es,rets)p Label lx'"
      by(erule containsCall_empty_Proc_CFG_Call_edge)
    hence "lx < #:c'" and "lx' < #:c'"
      by(auto intro:Proc_CFG_sourcelabel_less_num_nodes 
                    Proc_CFG_targetlabel_less_num_nodes)
    from lx < #:c' ‹Rep_wf_prog wfp = (prog,procs) (p',ins',outs',c')  set procs
      ‹containsCall procs prog ps' p' obtain asx 
      where "wfp  (p',Entry) -asx→* (p',Label lx)"
      and "a  set asx. intra_kind (kind a)"
      by(fastforce elim:Label_Proc_CFG_Entry_Exit_path_Proc)
    with pathE have pathE2:"CFG.valid_path' sourcenode targetnode kind 
      (valid_edge wfp) (get_return_edges wfp) (Main, Entry) (as@asx) (p', Label lx)"
      by(fastforce intro:ProcCFG.path_Append ProcCFG.valid_path_same_level_path_Append
        ProcCFG.intras_same_level_path simp:ProcCFG.vp_def)
    from lx' < #:c' ‹Rep_wf_prog wfp = (prog,procs)
      (p',ins',outs',c')  set procs ‹containsCall procs prog ps' p' 
    obtain asx' where "wfp  (p',Label lx') -asx'→* (p',Exit)"
      and "a  set asx'. intra_kind (kind a)"
      by(fastforce elim:Label_Proc_CFG_Entry_Exit_path_Proc)
    with pathX have pathX2:"CFG.valid_path' sourcenode targetnode kind 
      (valid_edge wfp) (get_return_edges wfp) (p', Label lx') (asx'@as') (Main, Exit)"
      by(fastforce intro:ProcCFG.path_Append ProcCFG.same_level_path_valid_path_Append
        ProcCFG.intras_same_level_path simp:ProcCFG.vp_def)
    from edge (p,ins,outs,c)  set procs (p',ins',outs',c')  set procs
      ‹containsCall procs prog ps' p'
    have "prog,procs  (p',Label lx) -(λs. True):(p',Label lx')p
      map (λe cf. interpret e cf) es (p,Entry)"
      and "prog,procs  (p,Exit) -(λcf. snd cf = (p',Label lx'))p
      (λcf cf'. cf'(rets [:=] map cf outs)) (p',Label lx')"
      by(fastforce intro:ProcCall ProcReturn)+
    with ‹Rep_wf_prog wfp = (prog,procs)
    have path:"wfp  (p',Label lx) -[((p',Label lx),(λs. True):(p',Label lx')p
      map (λe cf. interpret e cf) es,(p,Entry))]→* (p,Entry)"
      and path':"wfp  (p,Exit) -[((p,Exit),(λcf. snd cf = (p',Label lx'))p
      (λcf cf'. cf'(rets [:=] map cf outs)),(p',Label lx'))]→* 
      (p',Label lx')"
      by(fastforce intro:ProcCFG.path.intros 
                  simp:ProcCFG.valid_node_def valid_edge_def)+
    from path pathE2 have "CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
      (get_return_edges wfp) (Main, Entry) ((as@asx)@[((p',Label lx),
      (λs. True):(p',Label lx')pmap (λe cf. interpret e cf) es,(p,Entry))])
      (p,Entry)"
      apply(unfold ProcCFG.vp_def) apply(rule conjI)
       apply(fastforce intro:ProcCFG.path_Append)
      by(unfold ProcCFG.valid_path_def,fastforce intro:ProcCFG.vpa_snoc_Call)
    moreover
    from path' pathX2 have "CFG.valid_path' sourcenode targetnode kind 
      (valid_edge wfp) (get_return_edges wfp) (p,Exit)
      ([((p,Exit),(λcf. snd cf = (p',Label lx'))p
      (λcf cf'. cf'(rets [:=] map cf outs)),(p',Label lx'))]@(asx'@as')) (Main, Exit)"
      apply(unfold ProcCFG.vp_def) apply(rule conjI)
       apply(fastforce intro:ProcCFG.path_Append)
      by(simp add:ProcCFG.valid_path_def ProcCFG.valid_path_def)
    ultimately show ?case by blast
  qed
qed


lemma edge_valid_paths:
  assumes "prog,procs  sourcenode a -kind a targetnode a"
  and disj:"(p,n) = sourcenode a  (p,n) = targetnode a" 
  and [simp]:"Rep_wf_prog wfp = (prog,procs)"
  shows "as as'. CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
                (get_return_edges wfp) (Main,Entry) as (p,n) 
              CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
                (get_return_edges wfp) (p,n) as' (Main,Exit)"
proof -
  from ‹Rep_wf_prog wfp = (prog,procs) have wf:"well_formed procs"
    by(fastforce intro:wf_wf_prog)
  from prog,procs  sourcenode a -kind a targetnode a
  show ?thesis
  proof(induct "sourcenode a" "kind a" "targetnode a" rule:PCFG.induct)
    case (Main nx nx')
    from (Main, nx) = sourcenode a[THEN sym] (Main, nx') = targetnode a[THEN sym]
      disj have [simp]:"p = Main" by auto
    have "prog,procs  (Main, Entry) -(λs. False) (Main, Exit)"
      by(fastforce intro:PCFG.Main Proc_CFG_Entry_Exit)
    hence EXpath:"wfp  (Main,Entry) -[((Main,Entry),(λs. False),(Main,Exit))]→*
        (Main,Exit)"
      by(fastforce intro:ProcCFG.path.intros
        simp:valid_edge_def ProcCFG.valid_node_def)
    show ?case
    proof(cases n)
      case (Label l)
      with prog  nx -IEdge (kind a)p nx' (Main, nx) = sourcenode a[THEN sym]
        (Main, nx') = targetnode a[THEN sym] disj
      have "l < #:prog" by(auto intro:Proc_CFG_sourcelabel_less_num_nodes
        Proc_CFG_targetlabel_less_num_nodes)
      with ‹Rep_wf_prog wfp = (prog,procs) 
      obtain as as' where "wfp  (Main,Entry) -as→* (Main,Label l)"
        and "a  set as. intra_kind (kind a)"
        and "wfp  (Main,Label l) -as'→* (Main,Exit)"
        and "a  set as'. intra_kind (kind a)"
        by -(erule Label_Proc_CFG_Entry_Exit_path_Main)+
      with Label show ?thesis
        apply(rule_tac x="as" in exI) apply(rule_tac x="as'" in exI) apply simp
        by(fastforce intro:ProcCFG.intra_path_vp simp:ProcCFG.intra_path_def)
    next
      case Entry
      hence "wfp  (Main,Entry) -[]→* (Main,n)" by(fastforce intro:ProcCFG.empty_path)
      with EXpath show ?thesis by(fastforce simp:ProcCFG.vp_def ProcCFG.valid_path_def)
    next
      case Exit
      hence "wfp  (Main,n) -[]→* (Main,Exit)" by(fastforce intro:ProcCFG.empty_path)
      with Exit EXpath show ?thesis using Exit
        apply(rule_tac x="[((Main,Entry),(λs. False),(Main,Exit))]" in exI) 
        apply simp
        by(fastforce intro:ProcCFG.intra_path_vp 
          simp:ProcCFG.intra_path_def intra_kind_def)
    qed
  next
    case (Proc px ins outs c nx nx' ps)
    from (px, ins, outs, c)  set procs wf have [simp]:"px  Main" by auto
    from disj (px, nx) = sourcenode a[THEN sym] (px, nx') = targetnode a[THEN sym]
    have [simp]:"p = px" by auto
    from ‹Rep_wf_prog wfp = (prog,procs) 
      ‹containsCall procs prog ps px (px, ins, outs, c)  set procs
    obtain asx asx' where path:"CFG.valid_path' sourcenode targetnode kind
      (valid_edge wfp) (get_return_edges wfp) (Main,Entry) asx (px,Entry)"
      and path':"CFG.valid_path' sourcenode targetnode kind
      (valid_edge wfp) (get_return_edges wfp) (px,Exit) asx' (Main,Exit)"
      by -(erule Entry_to_Entry_and_Exit_to_Exit)+
    from ‹containsCall procs prog ps px (px, ins, outs, c)  set procs
    have "prog,procs  (px, Entry) -(λs. False) (px, Exit)"
      by(fastforce intro:PCFG.Proc Proc_CFG_Entry_Exit)
    hence EXpath:"wfp  (px,Entry) -[((px,Entry),(λs. False),(px,Exit))]→* 
      (px,Exit)" by(fastforce intro:ProcCFG.path.intros 
        simp:valid_edge_def ProcCFG.valid_node_def)
    show ?case
    proof(cases n)
      case (Label l)
      with c  nx -IEdge (kind a)p nx' disj (px, nx) = sourcenode a[THEN sym]
        (px, nx') = targetnode a[THEN sym]
      have "l < #:c" by(auto intro:Proc_CFG_sourcelabel_less_num_nodes
        Proc_CFG_targetlabel_less_num_nodes)
      with ‹Rep_wf_prog wfp = (prog,procs) (px, ins, outs, c)  set procs 
        ‹containsCall procs prog ps px
      obtain as as' where "wfp  (px,Entry) -as→* (px,Label l)"
        and "a  set as. intra_kind (kind a)"
        and "wfp  (px,Label l) -as'→* (px,Exit)"
        and "a  set as'. intra_kind (kind a)"
        by -(erule Label_Proc_CFG_Entry_Exit_path_Proc)+
      with path path' show ?thesis using Label
        apply(rule_tac x="asx@as" in exI) apply(rule_tac x="as'@asx'" in exI)
        by(auto intro:ProcCFG.path_Append ProcCFG.valid_path_same_level_path_Append
          ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
          simp:ProcCFG.vp_def)
    next
      case Entry
      from EXpath path' have "CFG.valid_path' sourcenode targetnode kind 
        (valid_edge wfp) (get_return_edges wfp) (px,Entry) 
        ([((px,Entry),(λs. False),(px,Exit))]@asx') (Main, Exit)"
        apply(unfold ProcCFG.vp_def) apply(erule conjE) apply(rule conjI)
        by(fastforce intro:ProcCFG.path_Append 
          ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
          simp:intra_kind_def)+
      with path Entry show ?thesis by simp blast
    next
      case Exit
      with path EXpath path' show ?thesis
        apply(rule_tac x="asx@[((px,Entry),(λs. False),(px,Exit))]" in exI)
        apply simp
        by(fastforce intro:ProcCFG.path_Append 
          ProcCFG.valid_path_same_level_path_Append ProcCFG.intras_same_level_path
          simp:ProcCFG.vp_def ProcCFG.intra_path_def intra_kind_def)
    qed
  next
    case (MainCall l px es rets nx' ins outs c)
    from disj show ?case
    proof
      assume "(p,n) = sourcenode a"
      with (Main, Label l) = sourcenode a[THEN sym] 
      have [simp]:"n = Label l" "p = Main" by simp_all
      with prog  Label l -CEdge (px, es, rets)p nx' have "l < #:prog"
        by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
      with ‹Rep_wf_prog wfp = (prog,procs) 
      obtain as as' where "wfp  (Main,Entry) -as→* (Main,Label l)"
        and "a  set as. intra_kind (kind a)"
        and "wfp  (Main,Label l) -as'→* (Main,Exit)"
        and "a  set as'. intra_kind (kind a)"
        by -(erule Label_Proc_CFG_Entry_Exit_path_Main)+
      thus ?thesis 
        by(fastforce intro:ProcCFG.intra_path_vp simp:ProcCFG.intra_path_def)
    next
      assume "(p,n) = targetnode a"
      with (px, Entry) = targetnode a[THEN sym] 
      have [simp]:"n = Entry" "p = px" by simp_all
      from prog  Label l -CEdge (px, es, rets)p nx'
      have "containsCall procs prog [] px" 
        by(rule Proc_CFG_Call_containsCall)
      with ‹Rep_wf_prog wfp = (prog,procs) (px, ins, outs, c)  set procs
      obtain as' where Xpath:"CFG.valid_path' sourcenode targetnode kind
        (valid_edge wfp) (get_return_edges wfp) (px,Exit) as' (Main,Exit)"
        by -(erule Entry_to_Entry_and_Exit_to_Exit)      
      from ‹containsCall procs prog [] px (px, ins, outs, c)  set procs
      have "prog,procs  (px, Entry) -(λs. False) (px, Exit)"
        by(fastforce intro:PCFG.Proc Proc_CFG_Entry_Exit)
      hence "wfp  (px,Entry) -[((px,Entry),(λs. False),(px,Exit))]→* (px,Exit)"
        by(fastforce intro:ProcCFG.path.intros 
          simp:valid_edge_def ProcCFG.valid_node_def)
      with Xpath have "CFG.valid_path' sourcenode targetnode kind
        (valid_edge wfp) (get_return_edges wfp) (px,Entry) 
        ([((px,Entry),(λs. False),(px,Exit))]@as') (Main,Exit)"
        apply(unfold ProcCFG.vp_def) apply(erule conjE) apply(rule conjI)
        by(fastforce intro:ProcCFG.path_Append 
          ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
          simp:intra_kind_def)+
      with ‹containsCall procs prog [] px ‹Rep_wf_prog wfp = (prog,procs)
        (px, ins, outs, c)  set procs
      show ?thesis by(fastforce elim:Entry_to_Entry_and_Exit_to_Exit)
    qed
  next
    case (ProcCall px ins outs c l p' es' rets' l' ins' outs' c' ps)
    from disj show ?case
    proof
      assume "(p,n) = sourcenode a"
      with (px, Label l) = sourcenode a[THEN sym] 
      have [simp]:"n = Label l" "p = px" by simp_all
      with c  Label l -CEdge (p', es', rets')p Label l' have "l < #:c"
        by(fastforce intro:Proc_CFG_sourcelabel_less_num_nodes)
      from ‹Rep_wf_prog wfp = (prog,procs) l < #:c 
        ‹containsCall procs prog ps px (px, ins, outs, c)  set procs
      obtain as as' where "wfp  (px,Label l) -as→* (px,Exit)"
        and "a  set as. intra_kind (kind a)"
        and "wfp  (px,Entry) -as'→* (px,Label l)"
        and "a  set as'. intra_kind (kind a)"
        by -(erule Label_Proc_CFG_Entry_Exit_path_Proc)+
      moreover
      from ‹Rep_wf_prog wfp = (prog,procs) ‹containsCall procs prog ps px
        (px, ins, outs, c)  set procs obtain asx asx' 
        where" CFG.valid_path' sourcenode targetnode kind
        (valid_edge wfp) (get_return_edges wfp) (Main,Entry) asx (px,Entry)"
        and "CFG.valid_path' sourcenode targetnode kind
        (valid_edge wfp) (get_return_edges wfp) (px,Exit) asx' (Main,Exit)"
        by -(erule Entry_to_Entry_and_Exit_to_Exit)+
      ultimately show ?thesis 
        apply(rule_tac x="asx@as'" in exI) apply(rule_tac x="as@asx'" in exI)
        by(auto intro:ProcCFG.path_Append ProcCFG.valid_path_same_level_path_Append
          ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
          simp:ProcCFG.vp_def)
    next
      assume "(p,n) = targetnode a"
      with (p', Entry) = targetnode a[THEN sym] 
      have [simp]:"n = Entry" "p = p'" by simp_all
      from c  Label l -CEdge (p', es', rets')p Label l'
      have "containsCall procs c [] p'" by(rule Proc_CFG_Call_containsCall)
      with ‹containsCall procs prog ps px (px, ins, outs, c)  set procs
      have "containsCall procs prog (ps@[px]) p'"
        by(rule containsCall_in_proc)
      with (p', ins', outs', c')  set procs
      have "prog,procs  (p', Entry) -(λs. False) (p', Exit)"
        by(fastforce intro:PCFG.Proc Proc_CFG_Entry_Exit)
      hence "wfp  (p',Entry) -[((p',Entry),(λs. False),(p',Exit))]→* (p',Exit)"
        by(fastforce intro:ProcCFG.path.intros 
          simp:valid_edge_def ProcCFG.valid_node_def)
      moreover
      from ‹Rep_wf_prog wfp = (prog,procs) (p', ins', outs', c')  set procs
        ‹containsCall procs prog (ps@[px]) p'
      obtain as as' where "CFG.valid_path' sourcenode targetnode kind
        (valid_edge wfp) (get_return_edges wfp) (Main,Entry) as (p',Entry)"
        and "CFG.valid_path' sourcenode targetnode kind
        (valid_edge wfp) (get_return_edges wfp) (p',Exit) as' (Main,Exit)"
        by -(erule Entry_to_Entry_and_Exit_to_Exit)+
      ultimately show ?thesis
        apply(rule_tac x="as" in exI)
        apply(rule_tac x="[((p',Entry),(λs. False),(p',Exit))]@as'" in exI)
        apply(unfold ProcCFG.vp_def)
        by(fastforce intro:ProcCFG.path_Append 
          ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
          simp:intra_kind_def)+
    qed
  next
    case (MainReturn l px es rets l' ins outs c)
    from disj show ?case
    proof
      assume "(p,n) = sourcenode a"
      with (px, Exit) = sourcenode a[THEN sym] 
      have [simp]:"n = Exit" "p = px" by simp_all
      from prog  Label l -CEdge (px, es, rets)p Label l'
      have "containsCall procs prog [] px" by(rule Proc_CFG_Call_containsCall)
      with (px, ins, outs, c)  set procs
      have "prog,procs  (px, Entry) -(λs. False) (px, Exit)"
        by(fastforce intro:PCFG.Proc Proc_CFG_Entry_Exit)
      hence "wfp  (px,Entry) -[((px,Entry),(λs. False),(px,Exit))]→* (px,Exit)"
        by(fastforce intro:ProcCFG.path.intros 
          simp:valid_edge_def ProcCFG.valid_node_def)
      moreover
      from ‹Rep_wf_prog wfp = (prog,procs) (px, ins, outs, c)  set procs
        ‹containsCall procs prog [] px
      obtain as as' where "CFG.valid_path' sourcenode targetnode kind
        (valid_edge wfp) (get_return_edges wfp) (Main,Entry) as (px,Entry)"
        and "CFG.valid_path' sourcenode targetnode kind
        (valid_edge wfp) (get_return_edges wfp) (px,Exit) as' (Main,Exit)"
        by -(erule Entry_to_Entry_and_Exit_to_Exit)+
      ultimately show ?thesis
        apply(rule_tac x="as@[((px,Entry),(λs. False),(px,Exit))]" in exI)
        apply(rule_tac x="as'" in exI)
        apply(unfold ProcCFG.vp_def)
        by(fastforce intro:ProcCFG.path_Append 
          ProcCFG.valid_path_same_level_path_Append ProcCFG.intras_same_level_path
          simp:intra_kind_def)+
    next
      assume "(p, n) = targetnode a"
      with (Main, Label l') = targetnode a[THEN sym] 
      have [simp]:"n = Label l'" "p = Main" by simp_all
      with prog  Label l -CEdge (px, es, rets)p Label l' have "l' < #:prog"
        by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
      with ‹Rep_wf_prog wfp = (prog,procs) 
      obtain as as' where "wfp  (Main,Entry) -as→* (Main,Label l')"
        and "a  set as. intra_kind (kind a)"
        and "wfp  (Main,Label l') -as'→* (Main,Exit)"
        and "a  set as'. intra_kind (kind a)"
        by -(erule Label_Proc_CFG_Entry_Exit_path_Main)+
      thus ?thesis 
        by(fastforce intro:ProcCFG.intra_path_vp simp:ProcCFG.intra_path_def)
    qed
  next
    case (ProcReturn px ins outs c l p' es' rets' l' ins' outs' c' ps)
    from disj show ?case
    proof
      assume "(p,n) = sourcenode a"
      with (p', Exit) = sourcenode a[THEN sym] 
      have [simp]:"n = Exit" "p = p'" by simp_all
      from c  Label l -CEdge (p', es', rets')p Label l'
      have "containsCall procs c [] p'" by(rule Proc_CFG_Call_containsCall)
      with ‹containsCall procs prog ps px (px, ins, outs, c)  set procs
      have "containsCall procs prog (ps@[px]) p'"
        by(rule containsCall_in_proc)
      with (p', ins', outs', c')  set procs
      have "prog,procs  (p', Entry) -(λs. False) (p', Exit)"
        by(fastforce intro:PCFG.Proc Proc_CFG_Entry_Exit)
      hence "wfp  (p',Entry) -[((p',Entry),(λs. False),(p',Exit))]→* (p',Exit)"
        by(fastforce intro:ProcCFG.path.intros 
          simp:valid_edge_def ProcCFG.valid_node_def)
      moreover
      from ‹Rep_wf_prog wfp = (prog,procs) (p', ins', outs', c')  set procs
        ‹containsCall procs prog (ps@[px]) p'
      obtain as as' where "CFG.valid_path' sourcenode targetnode kind
        (valid_edge wfp) (get_return_edges wfp) (Main,Entry) as (p',Entry)"
        and "CFG.valid_path' sourcenode targetnode kind
        (valid_edge wfp) (get_return_edges wfp) (p',Exit) as' (Main,Exit)"
        by -(erule Entry_to_Entry_and_Exit_to_Exit)+
      ultimately show ?thesis
        apply(rule_tac x="as@[((p',Entry),(λs. False),(p',Exit))]" in exI)
        apply(rule_tac x="as'" in exI)
        apply(unfold ProcCFG.vp_def)
        by(fastforce intro:ProcCFG.path_Append 
          ProcCFG.valid_path_same_level_path_Append ProcCFG.intras_same_level_path
          simp:intra_kind_def)+
    next
      assume "(p, n) = targetnode a"
      with (px, Label l') = targetnode a[THEN sym] 
      have [simp]:"n = Label l'" "p = px" by simp_all
      with c  Label l -CEdge (p', es', rets')p Label l' have "l' < #:c"
        by(fastforce intro:Proc_CFG_targetlabel_less_num_nodes)
      from ‹Rep_wf_prog wfp = (prog,procs) l' < #:c 
        ‹containsCall procs prog ps px (px, ins, outs, c)  set procs
      obtain as as' where "wfp  (px,Label l') -as→* (px,Exit)"
        and "a  set as. intra_kind (kind a)"
        and "wfp  (px,Entry) -as'→* (px,Label l')"
        and "a  set as'. intra_kind (kind a)"
        by -(erule Label_Proc_CFG_Entry_Exit_path_Proc)+
      moreover
      from ‹Rep_wf_prog wfp = (prog,procs) ‹containsCall procs prog ps px
        (px, ins, outs, c)  set procs obtain asx asx' 
        where" CFG.valid_path' sourcenode targetnode kind
        (valid_edge wfp) (get_return_edges wfp) (Main,Entry) asx (px,Entry)"
        and "CFG.valid_path' sourcenode targetnode kind
        (valid_edge wfp) (get_return_edges wfp) (px,Exit) asx' (Main,Exit)"
        by -(erule Entry_to_Entry_and_Exit_to_Exit)+
      ultimately show ?thesis 
        apply(rule_tac x="asx@as'" in exI) apply(rule_tac x="as@asx'" in exI)
        by(auto intro:ProcCFG.path_Append ProcCFG.valid_path_same_level_path_Append
          ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
          simp:ProcCFG.vp_def)
    qed
  next
    case (MainCallReturn nx px es rets nx')
    from prog  nx -CEdge (px, es, rets)p nx' disj
      (Main, nx) = sourcenode a[THEN sym] (Main, nx') = targetnode a[THEN sym]
    obtain l where [simp]:"n = Label l" "p = Main"
      by(fastforce dest:Proc_CFG_Call_Labels)
    from prog  nx -CEdge (px, es, rets)p nx' disj
      (Main, nx) = sourcenode a[THEN sym] (Main, nx') = targetnode a[THEN sym]
    have "l < #:prog" by(auto intro:Proc_CFG_sourcelabel_less_num_nodes
      Proc_CFG_targetlabel_less_num_nodes)
    with ‹Rep_wf_prog wfp = (prog,procs) 
    obtain as as' where "wfp  (Main,Entry) -as→* (Main,Label l)"
      and "a  set as. intra_kind (kind a)"
      and "wfp  (Main,Label l) -as'→* (Main,Exit)"
      and "a  set as'. intra_kind (kind a)"
      by -(erule Label_Proc_CFG_Entry_Exit_path_Main)+
    thus ?thesis
      apply(rule_tac x="as" in exI) apply(rule_tac x="as'" in exI) apply simp
      by(fastforce intro:ProcCFG.intra_path_vp simp:ProcCFG.intra_path_def)
  next
    case (ProcCallReturn px ins outs c nx p' es' rets' nx' ps)
    from (px, ins, outs, c)  set procs wf have [simp]:"px  Main" by auto
    from c  nx -CEdge (p', es', rets')p nx' disj 
      (px, nx) = sourcenode a[THEN sym] (px, nx') = targetnode a[THEN sym]
    obtain l where [simp]:"n = Label l" "p = px"
      by(fastforce dest:Proc_CFG_Call_Labels)
    from c  nx -CEdge (p', es', rets')p nx' disj 
    (px, nx) = sourcenode a[THEN sym] (px, nx') = targetnode a[THEN sym]
    have "l < #:c"
      by(auto intro:Proc_CFG_sourcelabel_less_num_nodes
        Proc_CFG_targetlabel_less_num_nodes)
    with ‹Rep_wf_prog wfp = (prog,procs) (px, ins, outs, c)  set procs 
      ‹containsCall procs prog ps px
    obtain as as' where "wfp  (px,Entry) -as→* (px,Label l)"
      and "a  set as. intra_kind (kind a)"
      and "wfp  (px,Label l) -as'→* (px,Exit)"
      and "a  set as'. intra_kind (kind a)"
      by -(erule Label_Proc_CFG_Entry_Exit_path_Proc)+
    moreover
    from ‹Rep_wf_prog wfp = (prog,procs) 
      ‹containsCall procs prog ps px (px, ins, outs, c)  set procs
    obtain asx asx' where "CFG.valid_path' sourcenode targetnode kind
      (valid_edge wfp) (get_return_edges wfp) (Main,Entry) asx (px,Entry)"
      and "CFG.valid_path' sourcenode targetnode kind
      (valid_edge wfp) (get_return_edges wfp) (px,Exit) asx' (Main,Exit)"
      by -(erule Entry_to_Entry_and_Exit_to_Exit)+
    ultimately show ?thesis
      apply(rule_tac x="asx@as" in exI) apply(rule_tac x="as'@asx'" in exI)
      by(auto intro:ProcCFG.path_Append ProcCFG.valid_path_same_level_path_Append
        ProcCFG.same_level_path_valid_path_Append ProcCFG.intras_same_level_path
        simp:ProcCFG.vp_def)
  qed
qed



subsection ‹Instantiating the Postdomination› locale›

interpretation ProcPostdomination:
  Postdomination sourcenode targetnode kind "valid_edge wfp" "(Main,Entry)"
  get_proc "get_return_edges wfp" "lift_procs wfp" Main "(Main,Exit)"
  for wfp
proof -
  from Rep_wf_prog[of wfp]
  obtain prog procs where [simp]:"Rep_wf_prog wfp = (prog,procs)" 
    by(fastforce simp:wf_prog_def)
  hence wf:"well_formed procs" by(fastforce intro:wf_wf_prog)
  show "Postdomination sourcenode targetnode kind (valid_edge wfp)
    (Main, Entry) get_proc (get_return_edges wfp) (lift_procs wfp) Main (Main, Exit)"
  proof
    fix m
    assume "CFG.valid_node sourcenode targetnode (valid_edge wfp) m"
    then obtain a where "valid_edge wfp a"
      and "m = sourcenode a  m = targetnode a"
      by(fastforce simp:ProcCFG.valid_node_def)
    obtain p n where [simp]:"m = (p,n)" by(cases m) auto
    from ‹valid_edge wfp a m = sourcenode a  m = targetnode a 
      ‹Rep_wf_prog wfp = (prog,procs)
    show "as. CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
      (get_return_edges wfp) (Main, Entry) as m"
      by(auto dest!:edge_valid_paths simp:valid_edge_def)
  next
    fix m
    assume "CFG.valid_node sourcenode targetnode (valid_edge wfp) m"
    then obtain a where "valid_edge wfp a"
      and "m = sourcenode a  m = targetnode a"
      by(fastforce simp:ProcCFG.valid_node_def)
    obtain p n where [simp]:"m = (p,n)" by(cases m) auto
    from ‹valid_edge wfp a m = sourcenode a  m = targetnode a 
      ‹Rep_wf_prog wfp = (prog,procs)
    show "as. CFG.valid_path' sourcenode targetnode kind (valid_edge wfp)
      (get_return_edges wfp) m as (Main,Exit)"
      by(auto dest!:edge_valid_paths simp:valid_edge_def)
  next
    fix n n'
    assume mex1:"CFGExit.method_exit sourcenode kind (valid_edge wfp) (Main,Exit) n"
      and mex2:"CFGExit.method_exit sourcenode kind (valid_edge wfp) (Main,Exit) n'"
      and "get_proc n = get_proc n'"
    from mex1 
    have "n = (Main,Exit)  (a Q p f. n = sourcenode a  valid_edge wfp a  
      kind a = Qpf)" by(simp add:ProcCFGExit.method_exit_def)
    thus "n = n'"
    proof
      assume "n = (Main,Exit)"
      from mex2 have "n' = (Main,Exit)  (a Q p f. n' = sourcenode a  
        valid_edge wfp a  kind a = Qpf)" 
        by(simp add:ProcCFGExit.method_exit_def)
      thus ?thesis
      proof
        assume "n' = (Main,Exit)"
        with n = (Main,Exit) show ?thesis by simp
      next
        assume "a Q p f. n' = sourcenode a  
          valid_edge wfp a  kind a = Qpf"
        then obtain a Q p f where "n' = sourcenode a"
          and "valid_edge wfp a" and "kind a = Qpf" by blast
        from ‹valid_edge wfp a ‹kind a = Qpf
        have "get_proc (sourcenode a) = p" by(rule ProcCFG.get_proc_return)
        with ‹get_proc n = get_proc n' n = (Main,Exit) n' = sourcenode a
        have "get_proc (Main,Exit) = p" by simp
        hence "p = Main" by simp
        with ‹kind a = Qpf have "kind a = QMainf" by simp
        with ‹valid_edge wfp a have False by(rule ProcCFG.Main_no_return_source)
        thus ?thesis by simp
      qed
    next
      assume "a Q p f. n = sourcenode a  
        valid_edge wfp a  kind a = Qpf"
      then obtain a Q p f where "n = sourcenode a"
        and "valid_edge wfp a" and "kind a = Qpf" by blast
      from ‹valid_edge wfp a ‹kind a = Qpf
      have "get_proc (sourcenode a) = p" by(rule ProcCFG.get_proc_return)
      from mex2 have "n' = (Main,Exit)  (a Q p f. n' = sourcenode a  
        valid_edge wfp a  kind a = Qpf)" 
        by(simp add:ProcCFGExit.method_exit_def)
      thus ?thesis
      proof
        assume "n' = (Main,Exit)"
        from ‹get_proc (sourcenode a) = p ‹get_proc n = get_proc n'
          n' = (Main,Exit) n = sourcenode a
        have "get_proc (Main,Exit) = p" by simp
        hence "p = Main" by simp
        with ‹kind a = Qpf have "kind a = QMainf" by simp
        with ‹valid_edge wfp a have False by(rule ProcCFG.Main_no_return_source)
        thus ?thesis by simp
      next
        assume "a Q p f. n' = sourcenode a  
          valid_edge wfp a  kind a = Qpf"
        then obtain a' Q' p' f' where "n' = sourcenode a'"
          and "valid_edge wfp a'" and "kind a' = Q'p'f'" by blast
        from ‹valid_edge wfp a' ‹kind a' = Q'p'f'
        have "get_proc (sourcenode a') = p'" by(rule ProcCFG.get_proc_return)
        with ‹get_proc n = get_proc n' ‹get_proc (sourcenode a) = p
          n = sourcenode a n' = sourcenode a'
        have "p' = p" by simp
        from ‹valid_edge wfp a ‹kind a = Qpf
        have "sourcenode a = (p,Exit)" by(auto elim:PCFG.cases simp:valid_edge_def)
        from ‹valid_edge wfp a' ‹kind a' = Q'p'f'
        have "sourcenode a' = (p',Exit)" by(auto elim:PCFG.cases simp:valid_edge_def)
        with n = sourcenode a n' = sourcenode a' p' = p
          ‹sourcenode a = (p,Exit) show ?thesis by simp
      qed
    qed
  qed
qed


end

Theory ProcSDG

section ‹Instantiation of the SDG locale›

theory ProcSDG imports ValidPaths "../StaticInter/SDG" begin

interpretation Proc_SDG:
  SDG sourcenode targetnode kind "valid_edge wfp" "(Main,Entry)"
  get_proc "get_return_edges wfp" "lift_procs wfp" Main "(Main,Exit)"
  "Def wfp" "Use wfp" "ParamDefs wfp" "ParamUses wfp"
  for wfp ..

end

Theory JVMCFG

chapter ‹A Control Flow Graph for Jinja Byte Code›

section ‹Formalizing the CFG›

theory JVMCFG imports "../StaticInter/BasicDefs" Jinja.BVExample begin

declare lesub_list_impl_same_size [simp del]
declare listE_length [simp del]

subsection ‹Type definitions›

subsubsection ‹Wellformed Programs›

definition "wf_jvmprog = {(P, Phi). wf_jvm_progPhi P}"

typedef wf_jvmprog = "wf_jvmprog"
proof
  show "(E, Phi)  wf_jvmprog"
    unfolding wf_jvmprog_def by (auto intro: wf_prog)
qed

hide_const Phi E

abbreviation PROG :: "wf_jvmprog  jvm_prog"
  where "PROG P  fst(Rep_wf_jvmprog(P))"

abbreviation TYPING :: "wf_jvmprog  tyP"
  where "TYPING P  snd(Rep_wf_jvmprog(P))"

lemma wf_jvmprog_is_wf_typ: "wf_jvm_progTYPING P (PROG P)"
using Rep_wf_jvmprog [of P]
  by (auto simp: wf_jvmprog_def split_beta)

lemma wf_jvmprog_is_wf: "wf_jvm_prog (PROG P)"
  using wf_jvmprog_is_wf_typ unfolding wf_jvm_prog_def
  by blast

subsubsection ‹Interprocedural CFG›

type_synonym jvm_method = "wf_jvmprog × cname × mname"
datatype var = Heap | Local "nat" | Stack "nat" | Exception
datatype val = Hp "heap" | Value "Value.val"

type_synonym state = "var  val"

definition valid_state :: "state  bool"
  where "valid_state s  (val. s Heap  Some (Value val))
   (s Exception = None  (addr. s Exception = Some (Value (Addr addr))))
   (var. var  Heap  var  Exception  (h. s var  Some (Hp h)))"

fun the_Heap :: "val  heap"
  where "the_Heap (Hp h) = h"

fun the_Value :: "val  Value.val"
  where "the_Value (Value v) = v"

abbreviation heap_of :: "state  heap"
  where "heap_of s  the_Heap (the (s Heap))"

abbreviation exc_flag :: "state  addr option"
  where "exc_flag s  case (s Exception) of None  None
  | Some v  Some (THE a. v = Value (Addr a))"

abbreviation stkAt :: "state  nat  Value.val"
  where "stkAt s n  the_Value (the (s (Stack n)))"

abbreviation locAt :: "state  nat  Value.val"
  where "locAt s n  the_Value (the (s (Local n)))"

datatype nodeType = Enter | Normal | Return | Exceptional "pc option" "nodeType"
type_synonym cfg_node = "cname × mname × pc option × nodeType"

type_synonym
  cfg_edge = "cfg_node × (var, val, cname × mname × pc, cname × mname) edge_kind × cfg_node"

definition ClassMain :: "wf_jvmprog  cname"
  where "ClassMain P  SOME Name. ¬ is_class (PROG P) Name"

definition MethodMain :: "wf_jvmprog  mname"
  where "MethodMain P  SOME Name.
  C D fs ms. class (PROG P) C = (D, fs, ms)  (m  set ms. Name  fst m)"

definition stkLength :: "jvm_method  pc  nat"
  where
  "stkLength m pc  let (P, C, M) = m in (
  if (C = ClassMain P) then 1 else (
    length (fst(the(((TYPING P) C M) ! pc)))
  ))"

definition locLength :: "jvm_method  pc  nat"
  where
  "locLength m pc  let (P, C, M) = m in (
  if (C = ClassMain P) then 1 else (
    length (snd(the(((TYPING P) C M) ! pc)))
  ))"

lemma ex_new_class_name: "C. ¬ is_class P C"
proof -
  have "¬ finite (UNIV :: cname set)"
    by (rule infinite_UNIV_listI)
  hence "C. C  set (map fst P)"
    by -(rule ex_new_if_finite, auto)
  then obtain C where "C  set (map fst P)"
    by blast
  have "¬ is_class P C"
  proof
    assume "is_class P C"
    then obtain D fs ms where "class P C = (D, fs, ms)"
      by auto
    with C  set (map fst P) show False
      by (auto dest: map_of_SomeD intro!: image_eqI simp: class_def)
  qed
  thus ?thesis
    by blast
qed

lemma ClassMain_unique_in_P:
  assumes "is_class (PROG P) C"
  shows "ClassMain P  C"
proof -
  from ex_new_class_name [of "PROG P"] obtain D where "¬ is_class (PROG P) D"
    by blast
  with ‹is_class (PROG P) C show ?thesis
    unfolding ClassMain_def
    by -(rule someI2, fastforce+)
qed

lemma map_of_fstD: " map_of xs a = b; x  set xs. fst x  a   False"
  by (induct xs, auto)

lemma map_of_fstE: " map_of xs a = b; x  set xs. fst x = a  thesis   thesis"
  by (induct xs) (auto split: if_split_asm)

lemma ex_unique_method_name:
  "Name. C D fs ms. class (PROG P) C = (D, fs, ms)  (mset ms. Name  fst m)"
proof -
  from wf_jvmprog_is_wf [of P]
  have "distinct_fst (PROG P)"
    by (simp add: wf_jvm_prog_def wf_jvm_prog_phi_def wf_prog_def)
  hence "{C. D fs ms. class (PROG P) C = (D, fs, ms)} = fst ` set (PROG P)"
    by (fastforce elim: map_of_fstE simp: class_def intro: map_of_SomeI)
  hence "finite {C. D fs ms. class (PROG P) C = (D, fs, ms)}"
    by auto
  moreover have "{ms. C D fs. class (PROG P) C = (D, fs, ms)}
    = snd ` snd ` the ` (λC. class (PROG P) C) ` {C. D fs ms. class (PROG P) C = (D, fs, ms)}"
    by (fastforce intro: rev_image_eqI map_of_SomeI simp: class_def)
  ultimately have "finite {ms. C D fs. class (PROG P) C = (D, fs, ms)}"
    by auto
  moreover have "¬ finite (UNIV :: mname set)"
    by (rule infinite_UNIV_listI)
  ultimately
  have "Name. Name  fst ` (ms  {ms. C D fs. class (PROG P) C = (D, fs, ms)}. set ms)"
    by -(rule ex_new_if_finite, auto)
  thus ?thesis
    by fastforce
qed

lemma MethodMain_unique_in_P:
  assumes "PROG P  D sees M:TsT = mb in C"
  shows "MethodMain P  M"
proof -
  from ex_unique_method_name [of P] obtain M'
    where "C D fs ms. class (PROG P) C = (D, fs, ms)  (m  set ms. M'  fst m)"
    by blast
  with ‹PROG P  D sees M:TsT = mb in C
  show ?thesis
    unfolding MethodMain_def
    by -(rule someI2_ex, fastforce, fastforce dest!: visible_method_exists elim: map_of_fstE)
qed

lemma ClassMain_is_no_class [dest!]: "is_class (PROG P) (ClassMain P)  False"
proof (erule rev_notE)
  from ex_new_class_name [of "PROG P"] obtain C where "¬ is_class (PROG P) C"
    by blast
  thus "¬ is_class (PROG P) (ClassMain P)" unfolding ClassMain_def
    by (rule someI)
qed

lemma MethodMain_not_seen [dest!]: "PROG P  C sees (MethodMain P):TsT = mb in D  False"
  by (fastforce dest: MethodMain_unique_in_P)

lemma no_Call_from_ClassMain [dest!]: "PROG P  ClassMain P sees M:TsT = mb in C  False"
  by (fastforce dest: sees_method_is_class)

lemma no_Call_in_ClassMain [dest!]: "PROG P  C sees M:TsT = mb in ClassMain P  False"
  by (fastforce dest: sees_method_idemp)

inductive JVMCFG :: "jvm_method  cfg_node  (var, val, cname × mname × pc, cname × mname) edge_kind  cfg_node  bool" (" _  _ -_ _")
  and reachable :: "jvm_method  cfg_node  bool" (" _  _")
  where
    Entry_reachable: "(P, C0, Main)  (ClassMain P, MethodMain P, None, Enter)"
  | reachable_step: " P  n; P  n -(e) n'   P  n'"
  | Main_to_Call: "(P, C0, Main)  (ClassMain P, MethodMain P, 0, Enter)
   (P, C0, Main)  (ClassMain P, MethodMain P, 0, Enter) -id (ClassMain P, MethodMain P, 0, Normal)"
  | Main_Call_LFalse: "(P, C0, Main)  (ClassMain P, MethodMain P, 0, Normal)
   (P, C0, Main)  (ClassMain P, MethodMain P, 0, Normal) -(λs. False) (ClassMain P, MethodMain P, 0, Return)"
  | Main_Call: " (P, C0, Main)  (ClassMain P, MethodMain P, 0, Normal);
     PROG P  C0 sees Main:[]T = (mxs, mxl0, is, xt) in D;
     initParams = [(λs. s Heap),(λs. Value Null)];
     ek = (λ(s, ret). True):(ClassMain P, MethodMain P, 0)(D, Main)initParams 
   (P, C0, Main)  (ClassMain P, MethodMain P, 0, Normal) -(ek) (D, Main, None, Enter)"
  | Main_Return_to_Exit: "(P, C0, Main)  (ClassMain P, MethodMain P, 0, Return)
   (P, C0, Main)  (ClassMain P, MethodMain P, 0, Return) -(id) (ClassMain P, MethodMain P, None, Return)"
  | Method_LFalse: "(P, C0, Main)  (C, M, None, Enter)
   (P, C0, Main)  (C, M, None, Enter) -(λs. False) (C, M, None, Return)"
  | Method_LTrue: "(P, C0, Main)  (C, M, None, Enter)
   (P, C0, Main)  (C, M, None, Enter) -(λs. True) (C, M, 0, Enter)"
  | CFG_Load: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter); instrs_of (PROG P) C M ! pc = Load n;
    ek = (λs. s(Stack (stkLength (P, C, M) pc) := s (Local n))) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, Suc pc, Enter)"
  | CFG_Store: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter); instrs_of (PROG P) C M ! pc = Store n;
    ek = (λs. s(Local n := s (Stack (stkLength (P, C, M) pc - 1)))) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, Suc pc, Enter)"
  | CFG_Push: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter); instrs_of (PROG P) C M ! pc = Push v;
    ek = (λs. s(Stack (stkLength (P, C, M) pc)  Value v)) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, Suc pc, Enter)"
  | CFG_Pop: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter); instrs_of (PROG P) C M ! pc = Pop;
    ek = id 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, Suc pc, Enter)"
  | CFG_IAdd: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter); instrs_of (PROG P) C M ! pc = IAdd;
    ek = (λs. let i1 = the_Intg (stkAt s (stkLength (P, C, M) pc - 1));
                   i2 = the_Intg (stkAt s (stkLength (P, C, M) pc - 2))
                in s(Stack (stkLength (P, C, M) pc - 2)  Value (Intg (i1 + i2)))) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, Suc pc, Enter)"
  | CFG_Goto: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter); instrs_of (PROG P) C M ! pc = Goto i 
   (P, C0, Main)  (C, M, pc, Enter) -((λs. True)) (C, M, nat (int pc + i), Enter)"
  | CFG_CmpEq: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter); instrs_of (PROG P) C M ! pc = CmpEq;
    ek = (λs. let e1 = stkAt s (stkLength (P, C, M) pc - 1);
                   e2 = stkAt s (stkLength (P, C, M) pc - 2)
                in s(Stack (stkLength (P, C, M) pc - 2)  Value (Bool (e1 = e2)))) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, Suc pc, Enter)"
  | CFG_IfFalse_False: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = IfFalse i;
    i  1;
    ek = (λs. stkAt s (stkLength(P, C, M) pc - 1) = Bool False) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, nat (int pc + i), Enter)"
  | CFG_IfFalse_True: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = IfFalse i;
    ek = (λs. stkAt s (stkLength(P, C, M) pc - 1)  Bool False  i = 1) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, Suc pc, Enter)"
  | CFG_New_Check_Normal: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = New Cl;
    ek = (λs. new_Addr (heap_of s)  None) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, pc, Normal)"
  | CFG_New_Check_Exceptional: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = New Cl;
    pc' = (case (match_ex_table (PROG P) OutOfMemory pc (ex_table_of (PROG P) C M)) of
             None  None
           | Some (pc'', d)  pc'');
    ek = (λs. new_Addr (heap_of s) = None) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, pc, Exceptional pc' Enter)"
  | CFG_New_Update: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Normal);
    instrs_of (PROG P) C M ! pc = New Cl;
    ek = (λs. let a = the (new_Addr (heap_of s))
                in s(Heap  Hp ((heap_of s)(a  blank (PROG P) Cl)))
                    (Stack (stkLength(P, C, M) pc)  Value (Addr a))) 
   (P, C0, Main)  (C, M, pc, Normal) -(ek) (C, M, Suc pc, Enter)"
  | CFG_New_Exceptional_prop: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Exceptional None Enter);
    instrs_of (PROG P) C M ! pc = New Cl;
    ek = (λs. s(Exception  Value (Addr (addr_of_sys_xcpt OutOfMemory)))) 
   (P, C0, Main)  (C, M, pc, Exceptional None Enter) -(ek) (C, M, None, Return)"
  | CFG_New_Exceptional_handle: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Exceptional pc' Enter);
    instrs_of (PROG P) C M ! pc = New Cl;
    ek = (λs. s(Exception := None)
                (Stack (stkLength (P, C, M) pc' - 1)  Value (Addr (addr_of_sys_xcpt OutOfMemory)))) 
   (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) -(ek) (C, M, pc', Enter)"
  | CFG_Getfield_Check_Normal: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = Getfield F Cl;
    ek = (λs. stkAt s (stkLength (P, C, M) pc - 1)  Null) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, pc, Normal)"
  | CFG_Getfield_Check_Exceptional: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = Getfield F Cl;
    pc' = (case (match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M)) of
             None  None
           | Some (pc'', d)  pc'');
    ek = (λs. stkAt s (stkLength (P, C, M) pc - 1) = Null) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, pc, Exceptional pc' Enter)"
  | CFG_Getfield_Update: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Normal);
    instrs_of (PROG P) C M ! pc = Getfield F Cl;
    ek = (λs. let (D, fs) = the (heap_of s (the_Addr (stkAt s (stkLength (P, C, M) pc - 1))))
                 in s(Stack (stkLength(P, C, M) pc - 1)  Value (the (fs (F, Cl))))) 
   (P, C0, Main)  (C, M, pc, Normal) -(ek) (C, M, Suc pc, Enter)"
  | CFG_Getfield_Exceptional_prop: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Exceptional None Enter);
    instrs_of (PROG P) C M ! pc = Getfield F Cl;
    ek = (λs. s(Exception  Value (Addr (addr_of_sys_xcpt NullPointer)))) 
   (P, C0, Main)  (C, M, pc, Exceptional None Enter) -(ek) (C, M, None, Return)"
  | CFG_Getfield_Exceptional_handle: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Exceptional pc' Enter);
    instrs_of (PROG P) C M ! pc = Getfield F Cl;
    ek = (λs. s(Exception := None)
                (Stack (stkLength (P, C, M) pc' - 1)  Value (Addr (addr_of_sys_xcpt NullPointer)))) 
   (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) -(ek) (C, M, pc', Enter)"
  | CFG_Putfield_Check_Normal: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = Putfield F Cl;
    ek = (λs. stkAt s (stkLength (P, C, M) pc - 2)  Null) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, pc, Normal)"
  | CFG_Putfield_Check_Exceptional: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = Putfield F Cl;
    pc' = (case (match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M)) of
             None  None
           | Some (pc'', d)  pc'');
    ek = (λs. stkAt s (stkLength (P, C, M) pc - 2) = Null) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, pc, Exceptional pc' Enter)"
  | CFG_Putfield_Update: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Normal);
    instrs_of (PROG P) C M ! pc = Putfield F Cl;
    ek = (λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
                   r = stkAt s (stkLength (P, C, M) pc - 2);
                   a = the_Addr r;
                   (D, fs) = the (heap_of s a);
                   h' = (heap_of s)(a  (D, fs((F, Cl)  v)))
                 in s(Heap  Hp h')) 
   (P, C0, Main)  (C, M, pc, Normal) -(ek) (C, M, Suc pc, Enter)"
  | CFG_Putfield_Exceptional_prop: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Exceptional None Enter);
    instrs_of (PROG P) C M ! pc = Putfield F Cl;
    ek = (λs. s(Exception  Value (Addr (addr_of_sys_xcpt NullPointer)))) 
   (P, C0, Main)  (C, M, pc, Exceptional None Enter) -(ek) (C, M, None, Return)"
  | CFG_Putfield_Exceptional_handle: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Exceptional pc' Enter);
    instrs_of (PROG P) C M ! pc = Putfield F Cl;
    ek = (λs. s(Exception := None)
                (Stack (stkLength (P, C, M) pc' - 1)  Value (Addr (addr_of_sys_xcpt NullPointer)))) 
   (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) -(ek) (C, M, pc', Enter)"
  | CFG_Checkcast_Check_Normal: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = Checkcast Cl;
    ek = (λs. cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1))) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, Suc pc, Enter)"
  | CFG_Checkcast_Check_Exceptional: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = Checkcast Cl;
    pc' = (case (match_ex_table (PROG P) ClassCast pc (ex_table_of (PROG P) C M)) of
             None  None
           | Some (pc'', d)  pc'');
    ek = (λs. ¬ cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1))) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, pc, Exceptional pc' Enter)"
  | CFG_Checkcast_Exceptional_prop: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Exceptional None Enter);
    instrs_of (PROG P) C M ! pc = Checkcast Cl;
    ek = (λs. s(Exception  Value (Addr (addr_of_sys_xcpt ClassCast)))) 
   (P, C0, Main)  (C, M, pc, Exceptional None Enter) -(ek) (C, M, None, Return)"
  | CFG_Checkcast_Exceptional_handle: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Exceptional pc' Enter);
    instrs_of (PROG P) C M ! pc = Checkcast Cl;
    ek = (λs. s(Exception := None)
                (Stack (stkLength (P, C, M) pc' - 1)  Value (Addr (addr_of_sys_xcpt ClassCast)))) 
   (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) -(ek) (C, M, pc', Enter)"
  | CFG_Throw_Check: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = Throw;
    pc' = None  match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = (the pc', d);
    ek = (λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
                  Cl = if (v = Null) then NullPointer else (cname_of (heap_of s) (the_Addr v))
               in case pc' of
                  None  match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
                | Some pc''  d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M)
                                  = (pc'', d)
    ) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, pc, Exceptional pc' Enter)"

  | CFG_Throw_prop: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Exceptional None Enter);
    instrs_of (PROG P) C M ! pc = Throw;
    ek = (λs. s(Exception  Value (stkAt s (stkLength (P, C, M) pc - 1)))) 
   (P, C0, Main)  (C, M, pc, Exceptional None Enter) -(ek) (C, M, None, Return)"
  | CFG_Throw_handle: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Exceptional pc' Enter);
    pc'  length (instrs_of (PROG P) C M);
    instrs_of (PROG P) C M ! pc = Throw;
    ek = (λs. s(Exception := None)
                (Stack (stkLength (P, C, M) pc' - 1)  Value (stkAt s (stkLength (P, C, M) pc - 1)))) 
   (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) -(ek) (C, M, pc', Enter)"
  | CFG_Invoke_Check_NP_Normal: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    ek = (λs. stkAt s (stkLength (P, C, M) pc - Suc n)  Null) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, pc, Normal)"
  | CFG_Invoke_Check_NP_Exceptional: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    pc' = (case (match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M)) of
             None  None
           | Some (pc'', d)  pc'');
    ek = (λs. stkAt s (stkLength (P, C, M) pc - Suc n) = Null) 
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, pc, Exceptional pc' Enter)"
  | CFG_Invoke_NP_prop: " C  ClassMain P;
    (P, C0, Main)  (C, M, pc, Exceptional None Enter);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    ek = (λs. s(Exception  Value (Addr (addr_of_sys_xcpt NullPointer)))) 
   (P, C0, Main)  (C, M, pc, Exceptional None Enter) -(ek) (C, M, None, Return)"
  | CFG_Invoke_NP_handle: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Exceptional pc' Enter);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    ek = (λs. s(Exception := None)
                (Stack (stkLength (P, C, M) pc' - 1)  Value (Addr (addr_of_sys_xcpt NullPointer)))) 
   (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) -(ek) (C, M, pc', Enter)"
  | CFG_Invoke_Call: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Normal);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    TYPING P C M ! pc = (ST, LT);
    ST ! n = Class D';
    PROG P  D' sees M':TsT = (mxs, mxl0, is, xt) in D;
    Q = (λ(s, ret). let r = stkAt s (stkLength (P, C, M) pc - Suc n);
                        C' = fst (the (heap_of s (the_Addr r)))
                     in D = fst (method (PROG P) C' M'));
    paramDefs = (λs. s Heap)
                # (λs. s (Stack (stkLength (P, C, M) pc - Suc n)))
                # (rev (map (λi. (λs. s (Stack (stkLength (P, C, M) pc - Suc i)))) [0..<n]));
    ek = Q:(C, M, pc)(D,M')paramDefs
  
   (P, C0, Main)  (C, M, pc, Normal) -(ek) (D, M', None, Enter)"
  | CFG_Invoke_False: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Normal);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    ek = (λs. False)
  
   (P, C0, Main)  (C, M, pc, Normal) -(ek) (C, M, pc, Return)"
  | CFG_Invoke_Return_Check_Normal: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Return);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    (TYPING P) C M ! pc = (ST, LT);
    ST ! n  NT;
    ek = (λs. s Exception = None)
  
   (P, C0, Main)  (C, M, pc, Return) -(ek) (C, M, Suc pc, Enter)"
  | CFG_Invoke_Return_Check_Exceptional: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Return);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = (pc', diff);
    pc'  length (instrs_of (PROG P) C M);
    ek = (λs. v d. s Exception = v 
                  match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc (ex_table_of (PROG P) C M) = (pc', d))
  
   (P, C0, Main)  (C, M, pc, Return) -(ek) (C, M, pc, Exceptional pc' Return)"
  | CFG_Invoke_Return_Exceptional_handle: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Exceptional pc' Return);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    ek = (λs. s(Exception := None,
                 Stack (stkLength (P, C, M) pc' - 1) := s Exception)) 
   (P, C0, Main)  (C, M, pc, Exceptional pc' Return) -(ek) (C, M, pc', Enter)"
  | CFG_Invoke_Return_Exceptional_prop: " C  ClassMain P;
    (P, C0, Main)  (C, M, pc, Return);
    instrs_of (PROG P) C M ! pc = Invoke M' n;
    ek = (λs. v. s Exception = v 
              match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc (ex_table_of (PROG P) C M) = None) 
   (P, C0, Main)  (C, M, pc, Return) -(ek) (C, M, None, Return)"
  | CFG_Return: " C  ClassMain P; (P, C0, Main)  (C, M, pc, Enter);
    instrs_of (PROG P) C M ! pc = instr.Return;
    ek = (λs. s(Stack 0 := s (Stack (stkLength (P, C, M) pc - 1))))
  
   (P, C0, Main)  (C, M, pc, Enter) -(ek) (C, M, None, Return)"
  | CFG_Return_from_Method: " (P, C0, Main)  (C, M, None, Return);
    (P, C0, Main)  (C', M', pc', Normal) -(Q':(C', M', pc')(C,M)ps) (C, M, None, Enter);
    Q = (λ(s, ret). ret = (C', M', pc'));
    stateUpdate = (λs s'. s'(Heap := s Heap,
                            Exception := s Exception,
                            Stack (stkLength (P, C', M') (Suc pc') - 1) := s (Stack 0))
                  );
    ek = Q(C, M)stateUpdate
  
   (P, C0, Main)  (C, M, None, Return) -(ek) (C', M', pc', Return)"


(* This takes veeeery long *)
lemma JVMCFG_edge_det: " P  n -(et) n'; P  n -(et') n'   et = et'"
  by (erule JVMCFG.cases) (erule JVMCFG.cases, (fastforce dest: sees_method_fun)+)+

lemma sourcenode_reachable: "P  n -(ek) n'  P  n"
  by (erule JVMCFG.cases, auto)

lemma targetnode_reachable:
  assumes edge: "P  n -(ek) n'"
  shows "P  n'"
proof -
  from edge have "P  n"
    by -(drule sourcenode_reachable)
  with edge show ?thesis
    by -(rule JVMCFG_reachable.intros)
qed

lemmas JVMCFG_reachable_inducts = JVMCFG_reachable.inducts[split_format (complete)]

lemma ClassMain_imp_MethodMain:
  "(P, C0, Main)  (C', M', pc', nt') -ek (ClassMain P, M, pc, nt)  M = MethodMain P"
  "(P, C0, Main)  (ClassMain P, M, pc, nt)  M = MethodMain P"
proof (induct P=="P" C0"C0" MainMain C' M' pc' nt' ek C''=="ClassMain P" M pc nt and
              P=="P" C0"C0" MainMain C'=="ClassMain P" M pc nt
       rule: JVMCFG_reachable_inducts)
  case CFG_Return_from_Method
  thus ?case
    by (fastforce elim: JVMCFG.cases)
qed auto

lemma ClassMain_no_Call_target [dest!]:
  "(P, C0, Main)  (C, M, pc, nt) -Q:(C', M', pc')(D,M'')paramDefs (ClassMain P, M''', pc'', nt')
   False"
  and
  "(P, C0, Main)  (C, M, pc, nt)  True"
  by (induct  P C0 Main C M pc nt ek=="Q:(C', M', pc')(D,M'')paramDefs"
                         C''=="ClassMain P" M''' pc'' nt' and
               P C0 Main C M pc nt
    rule: JVMCFG_reachable_inducts) auto

lemma method_of_src_and_trg_exists:
  " (P, C0, Main)  (C', M', pc', nt') -ek (C, M, pc, nt); C  ClassMain P; C'  ClassMain P 
   (Ts T mb. (PROG P)  C sees M:TsT = mb in C) 
     (Ts T mb. (PROG P)  C' sees M':TsT = mb in C')"
  and method_of_reachable_node_exists:
  " (P, C0, Main)  (C, M, pc, nt); C  ClassMain P 
   Ts T mb. (PROG P)  C sees M:TsT = mb in C"
proof (induct rule: JVMCFG_reachable_inducts)
  case CFG_Invoke_Call
  thus ?case
    by (blast dest: sees_method_idemp)
next
  case (reachable_step P C0 Main C M pc nt ek C' M' pc' nt')
  show ?case
  proof (cases "C = ClassMain P")
    case True
    with (P, C0, Main)  (C, M, pc, nt) -ek (C', M', pc', nt') C'  ClassMain P
    show ?thesis
    proof cases
      case Main_Call
      thus ?thesis
        by (blast dest: sees_method_idemp)
    qed auto
  next
    case False
    with reachable_step show ?thesis
      by simp
  qed
qed simp_all

lemma " (P, C0, Main)  (C', M', pc', nt') -ek (C, M, pc, nt); C  ClassMain P; C'  ClassMain P 
   (case pc of None  True |
    pc''  (TYPING P) C M ! pc''  None  pc'' < length (instrs_of (PROG P) C M)) 
  (case pc' of None  True |
    pc''  (TYPING P) C' M' ! pc''  None  pc'' < length (instrs_of (PROG P) C' M'))"
  and instr_of_reachable_node_typable: " (P, C0, Main)  (C, M, pc, nt); C  ClassMain P 
   case pc of None  True |
  pc''  (TYPING P) C M ! pc''  None  pc'' < length (instrs_of (PROG P) C M)"
proof (induct rule: JVMCFG_reachable_inducts)
  case (CFG_Load C P C0 Main M pc n ek)
  from (P, C0, Main)  (C, M, pc, Enter) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Load show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Store C P C0 Main M pc n ek)
  from (P, C0, Main)  (C, M, pc, Enter) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Store show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Push C P C0 Main M pc v ek)
  from (P, C0, Main)  (C, M, pc, Enter) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Push show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Pop C P C0 Main M pc ek)
  from (P, C0, Main)  (C, M, pc, Enter) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Pop show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_IAdd C P C0 Main M pc ek)
  from (P, C0, Main)  (C, M, pc, Enter) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_IAdd show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Goto C P C0 Main M pc i)
  from (P, C0, Main)  (C, M, pc, Enter) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Goto show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_CmpEq C P C0 Main M pc ek)
  from (P, C0, Main)  (C, M, pc, Enter) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_CmpEq show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_IfFalse_False C P C0 Main M pc i ek)
  from (P, C0, Main)  (C, M, pc, Enter) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_IfFalse_False show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_IfFalse_True C P C0 Main M pc i ek)
  from (P, C0, Main)  (C, M, pc, Enter) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_IfFalse_True show ?case
    using [[simproc del: list_to_set_comprehension]] by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_New_Update C P C0 Main M pc Cl ek)
  from (P, C0, Main)  (C, M, pc, Normal) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_New_Update show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_New_Exceptional_handle C P C0 Main M pc pc' Cl ek)
  hence "TYPING P C M ! pc  None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) C  ClassMain P
  obtain Ts T mxs mxl0 where
    "PROG P  C sees M:TsT = (mxs, mxl0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with pc < length (instrs_of (PROG P) C M) ‹instrs_of (PROG P) C M ! pc = New Cl
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     New Cl,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) C  ClassMain P
    ‹instrs_of (PROG P) C M ! pc = New Cl obtain d'
    where "match_ex_table (PROG P) OutOfMemory pc (ex_table_of (PROG P) C M) = (pc', d')"
    by cases (fastforce elim: JVMCFG.cases)
  hence "(f, t, D, h, d)set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) OutOfMemory pc (f, t, D, h, d)  h = pc'  d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = New Cl
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Getfield_Update C P C0 Main M pc F Cl ek)
  from (P, C0, Main)  (C, M, pc, Normal) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Getfield_Update show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Getfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
  hence "TYPING P C M ! pc  None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) C  ClassMain P
  obtain Ts T mxs mxl0 where
    "PROG P  C sees M:TsT = (mxs, mxl0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with pc < length (instrs_of (PROG P) C M) ‹instrs_of (PROG P) C M ! pc = Getfield F Cl
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     Getfield F Cl,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) C  ClassMain P
    ‹instrs_of (PROG P) C M ! pc = Getfield F Cl obtain d'
    where "match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = (pc', d')"
    by cases (fastforce elim: JVMCFG.cases)
  hence "(f, t, D, h, d)set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) NullPointer pc (f, t, D, h, d)  h = pc'  d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = Getfield F Cl
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Putfield_Update C P C0 Main M pc F Cl ek)
  from (P, C0, Main)  (C, M, pc, Normal) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Putfield_Update show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Putfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
  hence "TYPING P C M ! pc  None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) C  ClassMain P
  obtain Ts T mxs mxl0 where
    "PROG P  C sees M:TsT = (mxs, mxl0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with pc < length (instrs_of (PROG P) C M) ‹instrs_of (PROG P) C M ! pc = Putfield F Cl
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     Putfield F Cl,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) C  ClassMain P
    ‹instrs_of (PROG P) C M ! pc = Putfield F Cl obtain d'
    where "match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = (pc', d')"
    by cases (fastforce elim: JVMCFG.cases)
  hence "(f, t, D, h, d)set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) NullPointer pc (f, t, D, h, d)  h = pc'  d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = Putfield F Cl
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Checkcast_Check_Normal C P C0 Main M pc Cl ek)
  from (P, C0, Main)  (C, M, pc, Enter) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Checkcast_Check_Normal show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next
  case (CFG_Checkcast_Exceptional_handle C P C0 Main M pc pc' Cl ek)
  hence "TYPING P C M ! pc  None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) C  ClassMain P
  obtain Ts T mxs mxl0 where
    "PROG P  C sees M:TsT = (mxs, mxl0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with pc < length (instrs_of (PROG P) C M) ‹instrs_of (PROG P) C M ! pc = Checkcast Cl
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     Checkcast Cl,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) C  ClassMain P
    ‹instrs_of (PROG P) C M ! pc = Checkcast Cl obtain d'
    where "match_ex_table (PROG P) ClassCast pc (ex_table_of (PROG P) C M) = (pc', d')"
    by cases (fastforce elim: JVMCFG.cases)
  hence "(f, t, D, h, d)set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) ClassCast pc (f, t, D, h, d)  h = pc'  d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = Checkcast Cl
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Throw_handle C P C0 Main M pc pc' ek)
  hence "TYPING P C M ! pc  None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) C  ClassMain P
  obtain Ts T mxs mxl0 where
    "PROG P  C sees M:TsT = (mxs, mxl0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with pc < length (instrs_of (PROG P) C M) ‹instrs_of (PROG P) C M ! pc = Throw›
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     Throw,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) C  ClassMain P
    ‹instrs_of (PROG P) C M ! pc = Throw› obtain d' Exc
    where "match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = (pc', d')"
    by cases (fastforce elim: JVMCFG.cases)
  hence "(f, t, D, h, d)set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) Exc pc (f, t, D, h, d)  h = pc'  d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = Throw›
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Invoke_NP_handle C P C0 Main M pc pc' M' n ek)
  hence "TYPING P C M ! pc  None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) C  ClassMain P
  obtain Ts T mxs mxl0 where
    "PROG P  C sees M:TsT = (mxs, mxl0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with pc < length (instrs_of (PROG P) C M) ‹instrs_of (PROG P) C M ! pc = Invoke M' n
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     Invoke M' n,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Enter) C  ClassMain P
    ‹instrs_of (PROG P) C M ! pc = Invoke M' n obtain d'
    where "match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = (pc', d')"
    by cases (fastforce elim: JVMCFG.cases)
  hence "(f, t, D, h, d)set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) NullPointer pc (f, t, D, h, d)  h = pc'  d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = Invoke M' n
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Invoke_Return_Exceptional_handle C P C0 Main M pc pc' M' n ek)
  hence "TYPING P C M ! pc  None" and "pc < length (instrs_of (PROG P) C M)"
    by simp_all
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Return) C  ClassMain P
  obtain Ts T mxs mxl0 where
    "PROG P  C sees M:TsT = (mxs, mxl0, instrs_of (PROG P) C M, ex_table_of (PROG P) C M) in C"
    by (fastforce dest: method_of_reachable_node_exists)
  with pc < length (instrs_of (PROG P) C M) ‹instrs_of (PROG P) C M ! pc = Invoke M' n
  have "PROG P,T,mxs,length (instrs_of (PROG P) C M),ex_table_of (PROG P) C M
     Invoke M' n,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
  moreover from (P, C0, Main)  (C, M, pc, Exceptional pc' Return) C  ClassMain P
    ‹instrs_of (PROG P) C M ! pc = Invoke M' n obtain d' Exc
    where "match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = (pc', d')"
    by cases (fastforce elim: JVMCFG.cases)
  hence "(f, t, D, h, d)set (ex_table_of (PROG P) C M).
    matches_ex_entry (PROG P) Exc pc (f, t, D, h, d)  h = pc'  d = d'"
    by -(drule match_ex_table_SomeD)
  ultimately show ?case using ‹instrs_of (PROG P) C M ! pc = Invoke M' n
    by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
next
  case (CFG_Invoke_Return_Check_Normal C P C0 Main M pc M' n ST LT ek)
  from (P, C0, Main)  (C, M, pc, Return) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with CFG_Invoke_Return_Check_Normal show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr [OF wf_jvmprog_is_wf_typ])
next 
  case (Method_LTrue P C0 Main C M)
  from (P, C0, Main)  (C, M, None, Enter) C  ClassMain P
  obtain Ts T mxs mxl0 "is" xt where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "instrs_of (PROG P) C M = is"
    by -(drule method_of_reachable_node_exists, auto)
  with Method_LTrue show ?case
    by (fastforce dest!: wt_jvm_prog_impl_wt_start [OF wf_jvmprog_is_wf_typ] simp: wt_start_def)
next
  case (reachable_step P C0 Main C M opc nt ek C' M' opc' nt')
  thus ?case
    by (cases "C = ClassMain P") (fastforce elim: JVMCFG.cases, simp)
qed simp_all

lemma reachable_node_impl_wt_instr:
  assumes "(P, C0, Main)  (C, M, pc, nt)"
  and "C  ClassMain P"
  shows "T mxs mpc xt. PROG P,T,mxs,mpc,xt  (instrs_of (PROG P) C M ! pc),pc :: TYPING P C M"
proof -
  from C  ClassMain P (P, C0, Main)  (C, M, pc, nt)
    method_of_reachable_node_exists [of P C0 Main C M "pc" nt]
    instr_of_reachable_node_typable [of P C0 Main C M "pc" nt]
  obtain Ts T mxs mxl0 "is" xt
    where "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    and "TYPING P C M ! pc  None"
    and "pc < length (instrs_of (PROG P) C M)"
    by fastforce+
  with wf_jvmprog_is_wf_typ [of P]
  have "PROG P,T,mxs,length is,xt  instrs_of (PROG P) C M ! pc,pc :: TYPING P C M"
    by (fastforce dest!: wt_jvm_prog_impl_wt_instr)
  thus ?thesis
    by blast
qed

lemma
  " (P, C0, Main)  (C, M, pc, nt) -ek (C', M', pc', nt'); C  ClassMain P  C'  ClassMain P 
   T mb D. PROG P  C0 sees Main:[]T = mb in D"
  and reachable_node_impl_Main_ex:
  " (P, C0, Main)  (C, M, pc, nt); C  ClassMain P
   T mb D. PROG P  C0 sees Main:[]T = mb in D"
  by (induct rule: JVMCFG_reachable_inducts) fastforce+

end

Theory JVMInterpretation

theory JVMInterpretation imports JVMCFG "../StaticInter/CFGExit" begin

section ‹Instatiation of the CFG› locale›

abbreviation sourcenode :: "cfg_edge  cfg_node"
  where "sourcenode e  fst e"

abbreviation targetnode :: "cfg_edge  cfg_node"
  where "targetnode e  snd(snd e)"

abbreviation kind :: "cfg_edge  (var, val, cname × mname × pc, cname × mname) edge_kind"
  where "kind e  fst(snd e)"

definition valid_edge :: "jvm_method  cfg_edge  bool"
  where "valid_edge P e  P  (sourcenode e) -(kind e) (targetnode e)"

fun methods :: "cname  JVMInstructions.jvm_method mdecl list  ((cname × mname) × var list × var list) list"
  where "methods C [] = []"
  | "methods C ((M, Ts, T, mb) # ms)
  = ((C, M), Heap # (map Local [0..<Suc (length Ts)]), [Heap, Stack 0, Exception]) # (methods C ms)"

fun procs :: "jvm_prog  ((cname × mname) × var list × var list) list"
  where "procs [] = []"
  |"procs ((C, D, fs, ms) # P) = (methods C ms) @ (procs P)"

lemma in_set_methodsI: "map_of ms M = (Ts, T, mxs, mxl0, is, xt)
   ((C', M), Heap # map Local [0..<length Ts] @ [Local (length Ts)], [Heap, Stack 0, Exception])
   set (methods C' ms)"
  by (induct rule: methods.induct) (auto split: if_split_asm)

lemma in_methods_in_msD: "((C, M), ins, outs)  set (methods D ms)
   M  set (map fst ms)  D = C"
  by (induct ms) auto

lemma in_methods_in_msD': "((C, M), ins, outs)  set (methods D ms)
   Ts T mb. (M, Ts, T, mb)  set ms
   D = C
   ins = Heap # (map Local [0..<Suc (length Ts)])
   outs = [Heap, Stack 0, Exception]"
  by (induct rule: methods.induct) fastforce+

lemma in_set_methodsE:
  assumes "((C, M), ins, outs)  set (methods D ms)"
  obtains Ts T mb
  where "(M, Ts, T, mb)  set ms"
  and "D = C"
  and "ins = Heap # (map Local [0..<Suc (length Ts)])"
  and "outs = [Heap, Stack 0, Exception]"
using assms
by (induct ms) fastforce+

lemma in_set_procsI:
  assumes sees: "P  D sees M: TsT = mb in D"
  and ins_def: "ins = Heap # map Local [0..<Suc (length Ts)]"
  and outs_def: "outs = [Heap, Stack 0, Exception]"
  shows "((D, M), ins, outs)  set (procs P)"
proof -
  from sees obtain D' fs ms where "map_of P D = (D', fs, ms)" and "map_of ms M = (Ts, T, mb)"
    by (fastforce dest: visible_method_exists simp: class_def)
  hence "(D, D', fs, ms)  set P"
    by -(drule map_of_SomeD)
  thus ?thesis
  proof (induct P)
    case Nil thus ?case by simp
  next
    case (Cons Class P)
    with ins_def outs_def ‹map_of ms M = (Ts, T, mb) show ?case
      by (cases Class, cases mb) (auto intro: in_set_methodsI)
  qed
qed

lemma distinct_methods: "distinct (map fst ms)  distinct (map fst (methods C ms))"
proof (induct ms)
  case Nil thus ?case by simp
next
  case (Cons M ms)
  thus ?case
    by (cases M) (auto dest: in_methods_in_msD)
qed

lemma in_set_procsD:
  "((C, M), ins, out)  set (procs P)  D fs ms. (C, D, fs, ms)  set P  M  set (map fst ms)"
proof (induct P)
  case Nil thus ?case by simp
next
  case (Cons Class P)
  thus ?case
    by (cases Class) (fastforce dest: in_methods_in_msD intro: rev_image_eqI)
qed

lemma in_set_procsE':
  assumes "((C, M), ins, outs)  set (procs P)"
  obtains D fs ms Ts T mb 
  where "(C, D, fs, ms)  set P"
  and "(M, Ts, T, mb)  set ms"
  and "ins = Heap # (map (λn. Local n) [0..<Suc (length Ts)])"
  and "outs = [Heap, Stack 0, Exception]"
  using assms
  by (induct P) (fastforce elim: in_set_methodsE)+
 
lemma distinct_Local_vars [simp]: "distinct (map Local [0..<n])"
  by (induct n) auto

lemma distinct_Stack_vars [simp]: "distinct (map Stack [0..<n])"
  by (induct n) auto

inductive_set get_return_edges :: "wf_jvmprog  cfg_edge  cfg_edge set"
  for P :: "wf_jvmprog" 
  and a :: "cfg_edge"
  where
  "kind a = Q:(C, M, pc)(D, M')paramDefs
   ((D, M', None, Return),
  (λ(s, ret). ret = (C, M, pc))(D, M')(λs s'. s'(Heap := s Heap, Exception := s Exception,
                                                Stack (stkLength (P, C, M) (Suc pc) - 1) := s (Stack 0))),
      (C, M, pc, Return))  (get_return_edges P a)"

lemma get_return_edgesE [elim!]:
  assumes "a  get_return_edges P a'"
  obtains Q C M pc D M' paramDefs where
  "kind a' = Q:(C, M, pc)(D, M')paramDefs"
  and "a = ((D, M', None, Return),
  (λ(s, ret). ret = (C, M, pc))(D, M')(λs s'. s'(Heap := s Heap, Exception := s Exception,
  Stack (stkLength (P, C, M) (Suc pc) - 1) := s (Stack 0))),
  (C, M, pc, Return))"
  using assms
  by -(cases a, cases a', clarsimp, erule get_return_edges.cases, fastforce)

lemma distinct_class_names: "distinct_fst (PROG P)"
  using wf_jvmprog_is_wf_typ [of P]
  by (clarsimp simp: wf_jvm_prog_phi_def wf_prog_def)

lemma distinct_method_names:
  "class (PROG P) C = (D, fs, ms)  distinct_fst ms"
  using wf_jvmprog_is_wf_typ [of P]
  unfolding wf_jvm_prog_phi_def
  by (fastforce dest: class_wf simp: wf_cdecl_def)

lemma distinct_fst_is_distinct_fst: "distinct_fst = BasicDefs.distinct_fst"
  by (simp add: distinct_fst_def BasicDefs.distinct_fst_def)

lemma ClassMain_not_in_set_PROG [dest!]: "(ClassMain P, D, fs, ms)  set (PROG P)  False"
  using distinct_class_names [of P] ClassMain_is_no_class [of P]
by (fastforce intro: map_of_SomeI simp: class_def)

lemma in_set_procsE:
  assumes "((C, M), ins, outs)  set (procs (PROG P))"
  obtains D fs ms Ts T mb 
  where "class (PROG P) C = (D, fs, ms)"
  and "PROG P  C sees M:TsT = mb in C"
  and "ins = Heap # (map (λn. Local n) [0..<Suc (length Ts)])"
  and "outs = [Heap, Stack 0, Exception]"
proof -
  from ((C, M), ins, outs)  set (procs (PROG P))
  obtain D fs ms Ts T mxs mxl0 "is" xt
    where "(C, D, fs, ms)  set (PROG P)"
    and "(M, Ts, T, mxs, mxl0, is, xt)  set ms"
    and "ins = Heap # (map (λn. Local n) [0..<Suc (length Ts)])"
    and "outs = [Heap, Stack 0, Exception]"
    by (fastforce elim: in_set_procsE')
  moreover from (C, D, fs, ms)  set (PROG P) distinct_class_names [of P]
  have "class (PROG P) C = (D, fs, ms)"
    by (fastforce intro: map_of_SomeI simp: class_def)
  moreover from wf_jvmprog_is_wf_typ [of P]
    (M, Ts, T, mxs, mxl0, is, xt)  set ms (C, D, fs, ms)  set (PROG P)
  have "PROG P  C sees M:TsT = (mxs, mxl0, is, xt) in C"
    by (fastforce intro: mdecl_visible simp: wf_jvm_prog_phi_def)
  ultimately show ?thesis using that by blast
qed

declare has_method_def [simp]

interpretation JVMCFG_Interpret:
  CFG "sourcenode" "targetnode" "kind" "valid_edge (P, C0, Main)"
  "(ClassMain P, MethodMain P, None, Enter)"
  "(λ(C, M, pc, type). (C, M))" "get_return_edges P"
  "((ClassMain P, MethodMain P),[],[]) # procs (PROG P)" "(ClassMain P, MethodMain P)"
  for P C0 Main
proof (unfold_locales)
  fix e
  assume "valid_edge (P, C0, Main) e"
    and "targetnode e = (ClassMain P, MethodMain P, None, Enter)"
  thus False
    by (auto simp: valid_edge_def)(erule JVMCFG.cases, auto)+
next
  show "(λ(C, M, pc, type). (C, M)) (ClassMain P, MethodMain P, None, Enter) =
    (ClassMain P, MethodMain P)"
    by simp
next
  fix a Q r p fs
  assume "valid_edge (P, C0, Main) a"
    and "kind a = Q:rpfs"
    and "sourcenode a = (ClassMain P, MethodMain P, None, Enter)"
  thus False
    by (auto simp: valid_edge_def) (erule JVMCFG.cases, auto)
next
  fix a a'
  assume "valid_edge (P, C0, Main) a"
    and "valid_edge (P, C0, Main) a'"
    and "sourcenode a = sourcenode a'"
    and "targetnode a = targetnode a'"
  thus "a = a'"
    by (cases a, cases a') (fastforce simp: valid_edge_def dest: JVMCFG_edge_det)
next
  fix a Q r f
  assume "valid_edge (P, C0, Main) a"
    and "kind a = Q:r(ClassMain P, MethodMain P)f"
  thus False
    by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)    
next
  fix a Q' f'
  assume "valid_edge (P, C0, Main) a" and "kind a = Q'(ClassMain P, MethodMain P)f'"
  thus False
    by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)+
next
  fix a Q r p fs
  assume "valid_edge (P, C0, Main) a"
    and "kind a = Q:rpfs"
  then obtain C M pc nt C' M' pc' nt'
    where "(P, C0, Main)  (C, M, pc, nt) -Q:rpfs (C', M', pc', nt')"
    by (cases a) (clarsimp simp: valid_edge_def)
  thus "ins outs.
    (p, ins, outs)  set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
  proof cases
    case (Main_Call T mxs mxl0 "is" xt initParams)
    hence "((C', Main), [Heap, Local 0], [Heap, Stack 0, Exception])  set (procs (PROG P))"
      and "p = (C', Main)"
      by (auto intro: in_set_procsI dest: sees_method_idemp)
    thus ?thesis by fastforce
  next
    case (CFG_Invoke_Call _ n _ _ _ Ts)
    hence "((C', M'), Heap # map (λn. Local n) [0..<Suc (length Ts)],
      [Heap, Stack 0, Exception])  set (procs (PROG P))"
      and "p = (C',M')"
      by (auto intro: in_set_procsI dest: sees_method_idemp)
    thus ?thesis by fastforce
  qed simp_all
next
  fix a
  assume "valid_edge (P, C0, Main) a" and "intra_kind (kind a)"
  thus "(λ(C, M, pc, type). (C, M)) (sourcenode a) =
    (λ(C, M, pc, type). (C, M)) (targetnode a)"
    by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto simp: intra_kind_def)
next
  fix a Q r p fs
  assume "valid_edge (P, C0, Main) a" and "kind a = Q:rpfs"
  thus "(λ(C, M, pc, type). (C, M)) (targetnode a) = p"
    by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)
next
  fix a Q' p f'
  assume "valid_edge (P, C0, Main) a" and "kind a = Q'pf'"
  thus "(λ(C, M, pc, type). (C, M)) (sourcenode a) = p"
    by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)
next
  fix a Q r p fs
  assume "valid_edge (P, C0, Main) a" and "kind a = Q:rpfs"
  thus "a'. valid_edge (P, C0, Main) a'  targetnode a' = targetnode a
     (Qx rx fsx. kind a' = Qx:rxpfsx)"
    by (cases a, clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)+
next
  fix a Q' p f'
  assume "valid_edge (P, C0, Main) a" and "kind a = Q'pf'"
  thus "a'. valid_edge (P, C0, Main) a'  sourcenode a' = sourcenode a
     (Qx fx. kind a' = Qxpfx)"
    by (cases a, clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)+
next
  fix a Q r p fs
  assume "valid_edge (P, C0, Main) a" and "kind a = Q:rpfs"
  then have "a'. a'  get_return_edges P a"
    by (cases p, cases r) (fastforce intro: get_return_edges.intros)
  then show "get_return_edges P a  {}"
    by (simp only: ex_in_conv) simp
next
  fix a a'
  assume "valid_edge (P, C0, Main) a" "a'  get_return_edges P a"
  then obtain Q C M pc D M' paramDefs
    where "(P, C0, Main)  sourcenode a -Q:(C, M, pc)(D, M')paramDefs targetnode a"
    and "kind a = Q:(C, M, pc)(D, M')paramDefs"
    and a'_def: "a' = ((D, M', None, nodeType.Return),
    λ(s, ret).
      ret = (C, M, pc)(D, M')λs s'. s'(Heap := s Heap, Exception := s Exception,
                           Stack (stkLength (P, C, M) (Suc pc) - 1) := s (Stack 0)),
    C, M, pc, nodeType.Return)"
    by (fastforce simp: valid_edge_def)
  thus "valid_edge (P, C0, Main) a'"
  proof cases
    case (Main_Call T mxs mxl0 "is" xt D')
    hence "D = D'" and "M' = Main"
      by simp_all
    with (P, C0, Main)  (ClassMain P, MethodMain P, 0, Normal)
      ‹PROG P  C0 sees Main: []T = (mxs, mxl0, is, xt) in D'
    have "(P, C0, Main)  (D, M', None, Enter)"
      by -(rule reachable_step, fastforce, fastforce intro: JVMCFG_reachable.Main_Call)
    hence "(P, C0, Main)  (D, M', None, nodeType.Return)"
      by -(rule reachable_step, fastforce, fastforce intro: JVMCFG_reachable.Method_LFalse)
    with a'_def Main_Call show ?thesis
      by (fastforce intro: CFG_Return_from_Method JVMCFG_reachable.Main_Call simp: valid_edge_def)
  next
    case (CFG_Invoke_Call _ _ _ M'' _ _ _ _ _ _ _ _ _ _ D')
    hence "D = D'" and "M' = M''"
      by simp_all
    with CFG_Invoke_Call
    have "(P, C0, Main)  (D, M', None, Enter)"
      by -(rule reachable_step, fastforce, fastforce intro: JVMCFG_reachable.CFG_Invoke_Call)
    hence "(P, C0, Main)  (D, M', None, nodeType.Return)"
      by -(rule reachable_step, fastforce, fastforce intro: JVMCFG_reachable.Method_LFalse)
    with a'_def CFG_Invoke_Call show ?thesis
      by (fastforce intro: CFG_Return_from_Method JVMCFG_reachable.CFG_Invoke_Call
        simp: valid_edge_def)
  qed simp_all
next
  fix a a'
  assume "valid_edge (P, C0, Main) a" and "a'  get_return_edges P a"
  thus "Q r p fs. kind a = Q:rpfs"
    by clarsimp
next
  fix a Q r p fs a'
  assume "valid_edge (P, C0, Main) a" and "kind a = Q:rpfs" and "a'  get_return_edges P a"
  thus "Q' f'. kind a' = Q'pf'"
    by clarsimp
next
  fix a Q' p f'
  assume "valid_edge (P, C0, Main) a" and "kind a = Q'pf'"
  show "∃!a'. valid_edge (P, C0, Main) a' 
                (Q r fs. kind a' = Q:rpfs)  a  get_return_edges P a'"
  proof (rule ex_ex1I)
    from ‹valid_edge (P, C0, Main) a
    have "(P, C0, Main)  sourcenode a -kind a targetnode a"
      by (clarsimp simp: valid_edge_def)
    from this ‹kind a = Q'pf'
    show "a'. valid_edge (P, C0, Main) a'  (Q r fs. kind a' = Q:rpfs)
       a  get_return_edges P a'"
      by cases (cases a, fastforce intro: get_return_edges.intros[simplified] simp: valid_edge_def)+
  next
    fix a' a''
    assume "valid_edge (P, C0, Main) a'
       (Q r fs. kind a' = Q:rpfs)  a  get_return_edges P a'"
       and "valid_edge (P, C0, Main) a''
       (Q r fs. kind a'' = Q:rpfs)  a  get_return_edges P a''"
    thus "a' = a''"
      by (cases a', cases a'', clarsimp simp: valid_edge_def)
    (erule JVMCFG.cases, simp_all, clarsimp? )+
  qed
next
  fix a a'
  assume "valid_edge (P, C0, Main) a" and "a'  get_return_edges P a"
  thus "a''. valid_edge (P, C0, Main) a'' 
    sourcenode a'' = targetnode a 
    targetnode a'' = sourcenode a'  kind a'' = (λcf. False)"
    by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto intro: JVMCFG_reachable.intros)
next
  fix a a'
  assume "valid_edge (P, C0, Main) a" and "a'  get_return_edges P a"
  thus "a''. valid_edge (P, C0, Main) a'' 
    sourcenode a'' = sourcenode a 
    targetnode a'' = targetnode a'  kind a'' = (λcf. False)"
    by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto intro: JVMCFG_reachable.intros)
next
  fix a Q r p fs
  assume "valid_edge (P, C0, Main) a" and "kind a = Q:rpfs"
  hence call: "(P, C0, Main)  sourcenode a -Q:rpfs targetnode a"
    by (clarsimp simp: valid_edge_def)
  show "∃!a'. valid_edge (P, C0, Main) a' 
    sourcenode a' = sourcenode a  intra_kind (kind a')"
  proof (rule ex_ex1I)
    from call
    show "a'. valid_edge (P, C0, Main) a'  sourcenode a' = sourcenode a  intra_kind (kind a')"
      by cases (fastforce intro: JVMCFG_reachable.intros simp: intra_kind_def valid_edge_def)+
  next
    fix a' a''
    assume "valid_edge (P, C0, Main) a'  sourcenode a' = sourcenode a  intra_kind (kind a')"
      and "valid_edge (P, C0, Main) a''  sourcenode a'' = sourcenode a  intra_kind (kind a'')"
    with call show "a' = a''"
      by (cases a, cases a', cases a'', clarsimp simp: valid_edge_def intra_kind_def)
    (erule JVMCFG.cases, simp_all, clarsimp?)+
  qed
next
  fix a Q' p f'
  assume "valid_edge (P, C0, Main) a" and "kind a = Q'pf'"
  hence return: "(P, C0, Main)  sourcenode a -Q'pf' targetnode a"
    by (clarsimp simp: valid_edge_def)
  show "∃!a'. valid_edge (P, C0, Main) a' 
    targetnode a' = targetnode a  intra_kind (kind a')"
  proof (rule ex_ex1I)
    from return
    show "a'. valid_edge (P, C0, Main) a'  targetnode a' = targetnode a  intra_kind (kind a')"
    proof cases
      case (CFG_Return_from_Method C M C' M' pc' Q'' ps Q stateUpdate)
      hence [simp]: "Q = Q'" and [simp]: "p = (C, M)" and [simp]: "f' = stateUpdate"
        by simp_all
      from (P, C0, Main)  (C', M', pc', Normal) -Q'':(C', M', pc')(C, M)ps (C, M, None, Enter)
      have invoke_reachable: "(P, C0, Main)  (C', M', pc', Normal)"
        by -(drule sourcenode_reachable)
      show ?thesis
      proof (cases "C' = ClassMain P")
        case True
        with invoke_reachable CFG_Return_from_Method show ?thesis
          by -(erule JVMCFG.cases, simp_all,
            fastforce intro: Main_Call_LFalse simp: valid_edge_def intra_kind_def)
      next
        case False
        with invoke_reachable CFG_Return_from_Method show ?thesis
          by -(erule JVMCFG.cases, simp_all,
            fastforce intro: CFG_Invoke_False simp: valid_edge_def intra_kind_def)
      qed
    qed simp_all
  next
    fix a' a''
    assume "valid_edge (P, C0, Main) a'  targetnode a' = targetnode a  intra_kind (kind a')"
      and "valid_edge (P, C0, Main) a''  targetnode a'' = targetnode a  intra_kind (kind a'')"
    with return show "a' = a''"
      by (cases, auto, cases a, cases a', cases a'', clarsimp simp: valid_edge_def intra_kind_def)
    (erule JVMCFG.cases, simp_all, clarsimp?)+
  qed
next
  fix a a' Q1 r1 p fs1 Q2 r2 fs2
  assume "valid_edge (P, C0, Main) a" and "valid_edge (P, C0, Main) a'"
    and "kind a = Q1:r1pfs1" and "kind a' = Q2:r2pfs2"
  thus "targetnode a = targetnode a'"
    by (cases a, cases a', clarsimp simp: valid_edge_def)
  (erule JVMCFG.cases, simp_all, clarsimp?)+
next
  from distinct_method_names [of P] distinct_class_names [of P]
  have "C D fs ms. (C, D, fs, ms)  set (PROG P)  distinct_fst ms"
    by (fastforce intro: map_of_SomeI simp: class_def)
  moreover {
    fix P
    assume "distinct_fst (P :: jvm_prog)"
      and "C D fs ms. (C, D, fs, ms)  set P  distinct_fst ms"
    hence "distinct_fst (procs P)"
      by (induct P, simp)
    (fastforce intro: equals0I rev_image_eqI dest: in_methods_in_msD in_set_procsD
      simp: distinct_methods distinct_fst_def)
  }
  ultimately have "distinct_fst (procs (PROG P))" using distinct_class_names [of P]
    by blast
  hence "BasicDefs.distinct_fst (procs (PROG P))"
    by (simp add: distinct_fst_is_distinct_fst)
  thus "BasicDefs.distinct_fst (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
    by (fastforce elim: in_set_procsE)
next
  fix C M P p ins outs
  assume "(p, ins, outs)  set (((C, M), [], []) # procs P)"
  thus "distinct ins"
  proof (induct P)
    case Nil
    thus ?case by simp
  next
    case (Cons Cl P)
    then obtain C D fs ms where "Cl = (C, D, fs, ms)"
      by (cases Cl) blast
    with Cons show ?case
      by hypsubst_thin (induct ms, auto)
  qed
next
  fix C M P p ins outs
  assume "(p, ins, outs)  set (((C, M), [], []) # procs P)"
  thus "distinct outs"
  proof (induct "P")
    case Nil
    thus ?case by simp
  next
    case (Cons Cl P)
    then obtain C D fs ms where "Cl = (C, D, fs, ms)"
      by (cases Cl) blast
    with Cons show ?case
      by hypsubst_thin (induct ms, auto)
  qed
qed

interpretation JVMCFG_Exit_Interpret:
  CFGExit "sourcenode" "targetnode" "kind" "valid_edge (P, C0, Main)"
  "(ClassMain P, MethodMain P, None, Enter)"
  "(λ(C, M, pc, type). (C, M))" "get_return_edges P"
  "((ClassMain P, MethodMain P),[],[]) # procs (PROG P)"
  "(ClassMain P, MethodMain P)" "(ClassMain P, MethodMain P, None, Return)"
  for P C0 Main
proof (unfold_locales)
  fix a
  assume "valid_edge (P, C0, Main) a"
    and "sourcenode a = (ClassMain P, MethodMain P, None, nodeType.Return)"
  thus False
    by (cases a, clarsimp simp: valid_edge_def) (erule JVMCFG.cases, simp_all, clarsimp)
next
  show "(λ(C, M, pc, type). (C, M)) (ClassMain P, MethodMain P, None, nodeType.Return) =
    (ClassMain P, MethodMain P)"
    by simp
next
  fix a Q p f
  assume "valid_edge (P, C0, Main) a"
    and "kind a = Qpf"
    and "targetnode a = (ClassMain P, MethodMain P, None, nodeType.Return)"
  thus False
    by (cases a, clarsimp simp: valid_edge_def) (erule JVMCFG.cases, simp_all)
next
  show "a. valid_edge (P, C0, Main) a 
    sourcenode a = (ClassMain P, MethodMain P, None, Enter) 
    targetnode a = (ClassMain P, MethodMain P, None, nodeType.Return) 
    kind a = (λs. False)"
    by (fastforce intro: JVMCFG_reachable.intros simp: valid_edge_def)
qed

end

Theory JVMCFG_wf

theory JVMCFG_wf imports JVMInterpretation "../StaticInter/CFGExit_wf" begin

inductive_set Def :: "wf_jvmprog  cfg_node  var set"
  for P :: "wf_jvmprog"
  and n :: "cfg_node"
where
  Def_Main_Heap:
  "n = (ClassMain P, MethodMain P, 0, Return)
   Heap  Def P n"
| Def_Main_Exception:
  "n = (ClassMain P, MethodMain P, 0, Return)
   Exception  Def P n"
| Def_Main_Stack_0:
  "n = (ClassMain P, MethodMain P, 0, Return)
   Stack 0  Def P n"
| Def_Load:
  " n = (C, M, pc, Enter);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = Load idx;
  i = stkLength (P, C, M) pc
   Stack i  Def P n"
| Def_Store:
  " n = (C, M, pc, Enter);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = Store idx 
   Local idx  Def P n"
| Def_Push:
  " n = (C, M, pc, Enter);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = Push v;
  i = stkLength (P, C, M) pc 
   Stack i  Def P n"
| Def_IAdd:
  " n = (C, M, pc, Enter);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = IAdd;
  i = stkLength (P, C, M) pc - 2 
   Stack i  Def P n"
| Def_CmpEq:
  " n = (C, M, pc, Enter);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = CmpEq;
  i = stkLength (P, C, M) pc - 2 
   Stack i  Def P n"
| Def_New_Heap:
  " n = (C, M, pc, Normal);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = New Cl 
   Heap  Def P n"
| Def_New_Stack:
  " n = (C, M, pc, Normal);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = New Cl;
  i = stkLength (P, C, M) pc 
   Stack i  Def P n"
| Def_Exception:
  " n = (C, M, pc, Exceptional pco nt);
  C  ClassMain P 
   Exception  Def P n"
| Def_Exception_handle:
  " n = (C, M, pc, Exceptional pc' Enter);
  C  ClassMain P;
  i = stkLength (P, C, M) pc' - 1 
   Stack i  Def P n"
| Def_Exception_handle_return:
  " n = (C, M, pc, Exceptional pc' Return);
  C  ClassMain P;
  i = stkLength (P, C, M) pc' - 1 
   Stack i  Def P n"
| Def_Getfield:
  " n = (C, M, pc, Normal);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = Getfield Cl Fd;
  i = stkLength (P, C, M) pc - 1 
   Stack i  Def P n"
| Def_Putfield:
  " n = (C, M, pc, Normal);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = Putfield Cl Fd 
   Heap  Def P n"
| Def_Invoke_Return_Heap:
  " n = (C, M, pc, Return);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = Invoke M' n' 
   Heap  Def P n"
| Def_Invoke_Return_Exception:
  " n = (C, M, pc, Return);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = Invoke M' n' 
   Exception  Def P n"
| Def_Invoke_Return_Stack:
  " n = (C, M, pc, Return);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = Invoke M' n';
  i = stkLength (P, C, M) (Suc pc) - 1 
   Stack i  Def P n"
| Def_Invoke_Call_Heap:
  " n = (C, M, None, Enter);
  C  ClassMain P 
   Heap  Def P n"
| Def_Invoke_Call_Local:
  " n = (C, M, None, Enter);
  C  ClassMain P;
  i < locLength (P, C, M) 0 
   Local i  Def P n"
| Def_Return:
  " n = (C, M, pc, Enter);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = instr.Return 
   Stack 0  Def P n"

inductive_set Use :: "wf_jvmprog  cfg_node  var set"
  for P :: "wf_jvmprog"
  and n :: "cfg_node"
where
  Use_Main_Heap:
  "n = (ClassMain P, MethodMain P, 0, Normal)
   Heap  Use P n"
| Use_Load:
  " n = (C, M, pc, Enter);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = Load idx 
   Local idx  Use P n"
| Use_Enter_Stack:
  " n = (C, M, pc, Enter);
  C  ClassMain P;
  case (instrs_of (PROG P) C M ! pc)
    of Store n'  d = 1
    | Getfield F Cl  d = 1
    | Putfield F Cl  d = 2
    | Checkcast Cl  d = 1
    | Invoke M' n'  d = Suc n'
    | IAdd  d  {1, 2}
    | IfFalse i  d = 1
    | CmpEq  d  {1 , 2}
    | Throw  d = 1
    | instr.Return  d = 1
    | _  False;
  i = stkLength (P, C, M) pc - d 
   Stack i  Use P n"
| Use_Enter_Local:
  " n = (C, M, pc, Enter);
  C  ClassMain P;
  instrs_of (PROG P) C M ! pc = Load n' 
   Local n'  Use P n"
| Use_Enter_Heap:
  " n = (C, M, pc, Enter);
  C  ClassMain P;
  case (instrs_of (PROG P) C M ! pc)
    of New Cl  True
    | Checkcast Cl  True
    | Throw  True
    | _  False 
   Heap  Use P n"
| Use_Normal_Heap:
  " n = (C, M, pc, Normal);
  C  ClassMain P;
  case (instrs_of (PROG P) C M ! pc)
    of New Cl  True
    | Getfield F Cl  True
    | Putfield F Cl  True
    | Invoke M' n'  True
    | _  False 
   Heap  Use P n"
| Use_Normal_Stack:
  " n = (C, M, pc, Normal);
  C  ClassMain P;
  case (instrs_of (PROG P) C M ! pc)
    of Getfield F Cl  d = 1
    | Putfield F Cl  d  {1, 2}
    | Invoke M' n'  d > 0  d  Suc n'
    | _  False;
  i = stkLength (P, C, M) pc - d 
   Stack i  Use P n"
| Use_Return_Heap:
  " n = (C, M, pc, Return);
  instrs_of (PROG P) C M ! pc = Invoke M' n'  C = ClassMain P 
   Heap  Use P n"
| Use_Return_Stack:
  " n = (C, M, pc, Return);
  (instrs_of (PROG P) C M ! pc = Invoke M' n'  i = stkLength (P, C, M) (Suc pc) - 1) 
  (C = ClassMain P  i = 0) 
   Stack i  Use P n"
| Use_Return_Exception:
  " n = (C, M, pc, Return);
  instrs_of (PROG P) C M ! pc = Invoke M' n'  C = ClassMain P 
   Exception  Use P n"
| Use_Exceptional_Stack:
  " n = (C, M, pc, Exceptional opc' nt);
  case (instrs_of (PROG P) C M ! pc)
    of Throw  True
    | _  False;
  i = stkLength (P, C, M) pc - 1 
   Stack i  Use P n"
| Use_Exceptional_Exception:
  " n = (C, M, pc, Exceptional pc' Return);
  instrs_of (PROG P) C M ! pc = Invoke M' n' 
   Exception  Use P n"
| Use_Method_Leave_Exception:
  " n = (C, M, None, Return);
  C  ClassMain P 
   Exception  Use P n"
| Use_Method_Leave_Heap:
  " n = (C, M, None, Return);
  C  ClassMain P 
   Heap  Use P n"
| Use_Method_Leave_Stack:
  " n = (C, M, None, Return);
  C  ClassMain P 
   Stack 0  Use P n"
| Use_Method_Entry_Heap:
  " n = (C, M, None, Enter);
  C  ClassMain P 
   Heap  Use P n"
| Use_Method_Entry_Local:
  " n = (C, M, None, Enter);
  C  ClassMain P;
  i < locLength (P, C, M) 0 
   Local i  Use P n"

fun ParamDefs :: "wf_jvmprog  cfg_node  var list"
where
  "ParamDefs P (C, M, pc, Return) = [Heap, Stack (stkLength (P, C, M) (Suc pc) - 1), Exception]"
  | "ParamDefs P (C, M, opc, nt) = []"

function ParamUses :: "wf_jvmprog  cfg_node  var set list"
where
  "ParamUses P (ClassMain P, MethodMain P, 0, Normal) = [{Heap},{}]"
  |
  "M  MethodMain P  opc  0  nt  Normal
   ParamUses P (ClassMain P, M, opc, nt) = []"
  |
  "C  ClassMain P
   ParamUses P (C, M, opc, nt) = (case opc of None  []
  | pc  (case nt of Normal  (case (instrs_of (PROG P) C M ! pc) of
      Invoke M' n  (
          {Heap} # rev (map (λn. {Stack (stkLength (P, C, M) pc - (Suc n))}) [0..<n + 1])
      )
      | _  [])
    | _  []
    )
  )"
  by atomize_elim auto
termination by lexicographic_order

lemma in_set_ParamDefsE:
  " V  set (ParamDefs P n);
  C M pc.  n = (C, M, pc, Return);
         V  {Heap, Stack (stkLength (P, C, M) (Suc pc) - 1), Exception}   thesis 
   thesis"
  by (cases "(P, n)" rule: ParamDefs.cases) auto

lemma in_set_ParamUsesE:
  assumes V_in_ParamUses: "V  (set (ParamUses P n))"
  obtains "n = (ClassMain P, MethodMain P, 0, Normal)" and "V = Heap"
  | C M pc M' n' i where "n = (C, M, pc, Normal)" and "instrs_of (PROG P) C M ! pc = Invoke M' n'"
    and "V = Heap  V = Stack (stkLength (P, C, M) pc - Suc i)" and "i < Suc n'" and "C  ClassMain P"
proof (cases "(P, n)" rule: ParamUses.cases)
  case 1 with V_in_ParamUses that show ?thesis by clarsimp
next
  case 2 with V_in_ParamUses that show ?thesis by clarsimp
next
  case (3 C P M pc nt)
  with V_in_ParamUses that show ?thesis
    using [[simproc del: list_to_set_comprehension]]
    by (cases nt, auto) (rename_tac a b, case_tac "instrs_of (PROG P) C M ! a", simp_all, fastforce)
qed

lemma sees_method_fun_wf:
  assumes "PROG P  D sees M': TsT = (mxs, mxl0, is, xt) in D"
  and "(D, D', fs, ms)  set (PROG P)"
  and "(M', Ts', T', mxs', mxl0', is', xt')  set ms"
  shows "Ts = Ts'  T = T'  mxs = mxs'  mxl0 = mxl0'  is = is'  xt = xt'"
proof -
  from distinct_class_names [of P] (D, D', fs, ms)  set (PROG P)
  have "class (PROG P) D = (D', fs, ms)"
    by (fastforce intro: map_of_SomeI simp: class_def)
  moreover with distinct_method_names have "distinct_fst ms"
    by fastforce
  ultimately show ?thesis using
    ‹PROG P  D sees M': TsT = (mxs, mxl0, is, xt) in D
    (M', Ts', T', mxs', mxl0', is', xt')  set ms
    by (fastforce dest: visible_method_exists map_of_SomeD distinct_fst_isin_same_fst
      simp: distinct_fst_is_distinct_fst)
qed

interpretation JVMCFG_wf:
  CFG_wf  "sourcenode" "targetnode" "kind" "valid_edge (P, C0, Main)"
  "(ClassMain P, MethodMain P, None, Enter)"
  "(λ(C, M, pc, type). (C, M))" "get_return_edges P"
  "((ClassMain P, MethodMain P),[],[]) # procs (PROG P)"
  "(ClassMain P, MethodMain P)"
  "Def P" "Use P" "ParamDefs P" "ParamUses P"
  for P C0 Main
proof (unfold_locales)
  show "Def P (ClassMain P, MethodMain P, None, Enter) = {} 
    Use P (ClassMain P, MethodMain P, None, Enter) = {}"
    by (fastforce elim: Def.cases Use.cases)
next
  fix a Q r p fs ins outs
  assume "valid_edge (P, C0, Main) a"
    and "kind a = Q:rpfs"
    and params: "(p, ins, outs)  set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
  hence "(P, C0, Main)  sourcenode a -Q:rpfs targetnode a"
    by (simp add: valid_edge_def)
  from this params show "length (ParamUses P (sourcenode a)) = length ins"
  proof cases
    case Main_Call
    with params show ?thesis
      by auto (erule in_set_procsE, auto dest: sees_method_idemp sees_method_fun)
  next
    case (CFG_Invoke_Call C M pc M' n ST LT D' Ts T mxs mxl0 "is" xt D Q' paramDefs)
    hence [simp]: "Q' = Q" and [simp]: "r = (C, M, pc)" and [simp]: "p = (D, M')"
      and [simp]: "fs = paramDefs"
      by simp_all
    from CFG_Invoke_Call obtain T' mxs' mpc' xt' where
      "PROG P,T',mxs',mpc',xt'  instrs_of (PROG P) C M ! pc,pc :: TYPING P C M"
      by (blast dest: reachable_node_impl_wt_instr)
    moreover from ‹PROG P  D' sees M': TsT = (mxs, mxl0, is, xt) in D
    have "PROG P  D sees M': TsT = (mxs, mxl0, is, xt) in D"
      by -(drule sees_method_idemp)
    with params have "PROG P  D sees M': TsT=(mxs, mxl0, is, xt) in D"
      and "ins = Heap # map Local [0..<Suc (length Ts)]"
      by (fastforce elim: in_set_procsE dest: sees_method_fun)+
    ultimately show ?thesis using CFG_Invoke_Call
      by (fastforce dest: sees_method_fun list_all2_lengthD simp: min_def)
  qed simp_all
next
  fix a
  assume "valid_edge (P, C0, Main) a"
  thus "distinct (ParamDefs P (targetnode a))"
    by (clarsimp simp: valid_edge_def) (erule JVMCFG.cases, auto)
next
  fix a Q' p f' ins outs
  assume "valid_edge (P, C0, Main) a"
    and "kind a = Q'pf'"
    and params: "(p, ins, outs)  set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
  hence "(P, C0, Main)  sourcenode a -Q'pf' targetnode a"
    by (simp add: valid_edge_def)
  from this params
  show "length (ParamDefs P (targetnode a)) = length outs"
    by cases (auto elim: in_set_procsE)
next
  fix n V
  assume params: "V  set (ParamDefs P n)"
    and vn: "CFG.valid_node sourcenode targetnode (valid_edge (P, C0, Main)) n"
  then obtain ek n'
    where ve:"valid_edge (P, C0, Main) (n, ek, n')  valid_edge (P, C0, Main) (n', ek, n)"
    by (fastforce simp: JVMCFG_Interpret.valid_node_def)
  from params obtain C M pc where [simp]: "n = (C, M, pc, Return)"
    and V: "V  {Heap, Stack (stkLength (P, C, M) (Suc pc) - 1), Exception}"
    by (blast elim: in_set_ParamDefsE)
  from ve show "V  Def P n"
  proof
    assume "valid_edge (P, C0, Main) (n, ek, n')"
    thus ?thesis unfolding valid_edge_def
    proof cases
      case Main_Return_to_Exit with V show ?thesis
        by (auto intro: Def_Main_Heap Def_Main_Stack_0 Def_Main_Exception simp: stkLength_def)
    next
      case CFG_Invoke_Return_Check_Normal with V show ?thesis
        by (fastforce intro: Def_Invoke_Return_Heap
          Def_Invoke_Return_Stack Def_Invoke_Return_Exception)
    next
      case CFG_Invoke_Return_Check_Exceptional with V show ?thesis
        by (fastforce intro: Def_Invoke_Return_Heap
          Def_Invoke_Return_Stack Def_Invoke_Return_Exception)
    next
      case CFG_Invoke_Return_Exceptional_prop with V show ?thesis
        by (fastforce intro: Def_Invoke_Return_Heap
          Def_Invoke_Return_Stack Def_Invoke_Return_Exception)
    qed simp_all
  next
    assume "valid_edge (P, C0, Main) (n', ek, n)"
    thus ?thesis unfolding valid_edge_def
    proof cases
      case Main_Call_LFalse with V show ?thesis
        by (auto intro: Def_Main_Heap Def_Main_Stack_0 Def_Main_Exception simp: stkLength_def)
    next
      case CFG_Invoke_False with V show ?thesis
        by (fastforce intro: Def_Invoke_Return_Heap
          Def_Invoke_Return_Stack Def_Invoke_Return_Exception)
    next
      case CFG_Return_from_Method with V show ?thesis
        by (fastforce elim!: JVMCFG.cases intro!: Def_Main_Stack_0
          intro: Def_Main_Heap Def_Main_Exception Def_Invoke_Return_Heap
          Def_Invoke_Return_Exception Def_Invoke_Return_Stack simp: stkLength_def)
    qed simp_all
  qed
next
  fix a Q r p fs ins outs V
  assume ve: "valid_edge (P, C0, Main) a"
    and kind: "kind a = Q:rpfs"
    and params: "(p, ins, outs)  set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
    and V: "V  set ins"
  from params V obtain D fs ms Ts T mb where "class (PROG P) (fst p) = (D, fs, ms)"
    and "method": "PROG P  (fst p) sees (snd p): TsT = mb in (fst p)"
    and ins: "ins = Heap # map Local [0..<Suc (length Ts)]"
    by (cases p) (fastforce elim: in_set_procsE)
  from ve kind show "V  Def P (targetnode a)" unfolding valid_edge_def
  proof cases
    case (Main_Call T' mxs mxl0 "is" xt D' initParams)
    with kind have "PROG P  D' sees Main: []T' = (mxs, mxl0, is, xt) in D'"
      and [simp]: "p = (D', Main)"
      by (auto dest: sees_method_idemp)
    with "method" have [simp]: "Ts = []" and [simp]: "T' = T" and [simp]: "mb = (mxs, mxl0, is, xt)"
      by (fastforce dest: sees_method_fun)+
    from Main_Call ins V show ?thesis
      by (fastforce intro!: Def_Invoke_Call_Heap Def_Invoke_Call_Local
        dest: sees_method_idemp wt_jvm_prog_impl_wt_start[OF wf_jvmprog_is_wf_typ]
        simp: locLength_def wt_start_def)
  next
    case (CFG_Invoke_Call C M pc M' n ST LT D' Ts' T' mxs mxl0 "is" xt D'')
    with kind have "PROG P  D'' sees M': Ts'T' = (mxs, mxl0, is, xt) in D''"
      and [simp]: "p = (D'', M')"
      by (auto dest: sees_method_idemp)
    with "method" have [simp]: "Ts' = Ts" and [simp]: "T' = T" and [simp]: "mb = (mxs, mxl0, is, xt)"
      by (fastforce dest: sees_method_fun)+
    from CFG_Invoke_Call ins V show ?thesis
      by (fastforce intro!: Def_Invoke_Call_Local Def_Invoke_Call_Heap
        dest: sees_method_idemp wt_jvm_prog_impl_wt_start[OF wf_jvmprog_is_wf_typ] list_all2_lengthD
        simp: locLength_def min_def wt_start_def)
  qed simp_all
next
  fix a Q r p fs
  assume "valid_edge (P, C0, Main) a" and "kind a = Q:rpfs"
  thus "Def P (sourcenode a) = {}" unfolding valid_edge_def
    by cases (auto elim: Def.cases)
next
  fix n V
  assume "CFG.valid_node sourcenode targetnode (valid_edge (P, C0, Main)) n"
    and V: "V  (set (ParamUses P n))"
  then obtain ek n'
    where ve:"valid_edge (P, C0, Main) (n, ek, n')  valid_edge (P, C0, Main) (n', ek, n)"
    by (fastforce simp: JVMCFG_Interpret.valid_node_def)
  from V obtain C M pc M' n'' i where
    V: "n = (ClassMain P, MethodMain P, 0, Normal)  V = Heap 
    n = (C, M, pc, Normal)  instrs_of (PROG P) C M ! pc = Invoke M' n'' 
      (V = Heap  V = Stack (stkLength (P, C, M) pc - Suc i))  i < Suc n''  C  ClassMain P"
    by -(erule in_set_ParamUsesE, fastforce+)
  from ve show "V  Use P n"
  proof
    assume "valid_edge (P, C0, Main) (n, ek, n')"
    from this V show ?thesis unfolding valid_edge_def
    proof cases
      case Main_Call_LFalse with V show ?thesis by (fastforce intro: Use_Main_Heap)
    next
      case Main_Call with V show ?thesis by (fastforce intro: Use_Main_Heap)
    next
      case CFG_Invoke_Call with V show ?thesis
        by (fastforce intro: Use_Normal_Heap Use_Normal_Stack [where d="Suc i"])
    next
      case CFG_Invoke_False with V show ?thesis
        by (fastforce intro: Use_Normal_Heap Use_Normal_Stack [where d="Suc i"])
    qed simp_all
  next
    assume "valid_edge (P, C0, Main) (n', ek, n)"
    from this V show ?thesis unfolding valid_edge_def
    proof cases
      case Main_to_Call with V show ?thesis by (fastforce intro: Use_Main_Heap)
    next
      case CFG_Invoke_Check_NP_Normal with V show ?thesis
        by (fastforce intro: Use_Normal_Heap Use_Normal_Stack [where d="Suc i"])
    qed simp_all
  qed
next
  fix a Q p f ins outs V
  assume "valid_edge (P, C0, Main) a"
    and "kind a = Qpf"
    and "(p, ins, outs)  set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
    and "V  set outs"
  thus "V  Use P (sourcenode a)" unfolding valid_edge_def
    by (cases, simp_all)
  (fastforce elim: in_set_procsE
    intro: Use_Method_Leave_Heap Use_Method_Leave_Stack Use_Method_Leave_Exception)
next
  fix a V s
  assume ve: "valid_edge (P, C0, Main) a"
    and V_notin_Def: "V  Def P (sourcenode a)"
    and ik: "intra_kind (kind a)"
    and pred: "JVMCFG_Interpret.pred (kind a) s"
  show "JVMCFG_Interpret.state_val
    (CFG.transfer (((ClassMain P, MethodMain P), [], []) # procs (PROG P)) (kind a) s) V
    = JVMCFG_Interpret.state_val s V"
  proof (cases s)
    case Nil
    thus ?thesis by simp
  next
    case [simp]: Cons
    with ve V_notin_Def ik pred show ?thesis unfolding valid_edge_def
    proof cases
      case CFG_Load with V_notin_Def show ?thesis by (fastforce intro: Def_Load)
    next case CFG_Store with V_notin_Def show ?thesis by (fastforce intro: Def_Store)
    next case CFG_Push with V_notin_Def show ?thesis by (fastforce intro: Def_Push)
    next case CFG_IAdd with V_notin_Def show ?thesis by (fastforce intro: Def_IAdd)
    next case CFG_CmpEq with V_notin_Def show ?thesis by (fastforce intro: Def_CmpEq)
    next case CFG_New_Update with V_notin_Def show ?thesis
        by (fastforce intro: Def_New_Heap Def_New_Stack)
    next case CFG_New_Exceptional_prop with V_notin_Def show ?thesis
        by (fastforce intro: Def_Exception)
    next case CFG_New_Exceptional_handle with V_notin_Def show ?thesis
        by (fastforce intro: Def_Exception Def_Exception_handle)
    next case CFG_Getfield_Update with V_notin_Def show ?thesis
        by (fastforce intro: Def_Getfield split: prod.split)
    next case CFG_Getfield_Exceptional_prop with V_notin_Def show ?thesis
        by (fastforce intro: Def_Exception)
    next case CFG_Getfield_Exceptional_handle with V_notin_Def show ?thesis
        by (fastforce intro: Def_Exception Def_Exception_handle)
    next case CFG_Putfield_Update with V_notin_Def show ?thesis
        by (fastforce intro: Def_Putfield split: prod.split)
    next case CFG_Putfield_Exceptional_prop with V_notin_Def show ?thesis
        by (fastforce intro: Def_Exception)
    next case CFG_Putfield_Exceptional_handle with V_notin_Def show ?thesis
        by (fastforce intro: Def_Exception Def_Exception_handle)
    next case CFG_Checkcast_Exceptional_prop with V_notin_Def show ?thesis
        by (fastforce intro: Def_Exception)
    next case CFG_Checkcast_Exceptional_handle with V_notin_Def show ?thesis
        by (fastforce intro: Def_Exception Def_Exception_handle)
    next case CFG_Throw_prop with V_notin_Def show ?thesis by (fastforce intro: Def_Exception)
    next case CFG_Throw_handle with V_notin_Def show ?thesis
        by (fastforce intro: Def_Exception Def_Exception_handle)
    next case CFG_Invoke_NP_prop with V_notin_Def show ?thesis by (fastforce intro: Def_Exception)
    next case CFG_Invoke_NP_handle with V_notin_Def show ?thesis
        by (fastforce intro: Def_Exception Def_Exception_handle)
    next case CFG_Invoke_Return_Exceptional_handle with V_notin_Def show ?thesis
        by (fastforce intro: Def_Exception_handle_return Def_Exception)
    next case CFG_Return with V_notin_Def show ?thesis by (fastforce intro: Def_Return)
    qed (simp_all add: intra_kind_def)
  qed
next
  fix a s s'
  assume ve: "valid_edge (P, C0, Main) a"
    and use_Eq: "VUse P (sourcenode a). JVMCFG_Interpret.state_val s V
    = JVMCFG_Interpret.state_val s' V"
    and ik: "intra_kind (kind a)"
    and pred_s: "JVMCFG_Interpret.pred (kind a) s"
    and pred_s': "JVMCFG_Interpret.pred (kind a) s'"
  then obtain cfs C M pc cs cfs' C' M' pc' cs' where [simp]: "s = (cfs, (C, M, pc)) # cs"
    and [simp]: "s' = (cfs', (C', M', pc')) # cs'"
    by (cases s, fastforce) (cases s', fastforce+)
  from ve show "VDef P (sourcenode a).
             JVMCFG_Interpret.state_val
              (CFG.transfer (((ClassMain P, MethodMain P), [], []) # procs (PROG P)) (kind a) s) V =
             JVMCFG_Interpret.state_val
              (CFG.transfer (((ClassMain P, MethodMain P), [], []) # procs (PROG P)) (kind a) s') V"
    unfolding valid_edge_def
  proof cases
    case Main_Call with ik show ?thesis by (simp add: intra_kind_def)
  next case Main_Return_to_Exit with use_Eq show ?thesis
      by (fastforce elim: Def.cases intro: Use_Return_Heap Use_Return_Exception Use_Return_Stack)
  next case Method_LFalse with use_Eq show ?thesis
      by (fastforce elim: Def.cases intro: Use_Method_Entry_Heap Use_Method_Entry_Local) 
  next case Method_LTrue with use_Eq show ?thesis
      by (fastforce elim: Def.cases intro: Use_Method_Entry_Heap Use_Method_Entry_Local)
  next case CFG_Load with use_Eq show ?thesis
      by (fastforce elim: Def.cases intro: Use_Enter_Local)
  next case CFG_Store with use_Eq show ?thesis
      by (fastforce elim: Def.cases intro: Use_Enter_Stack)
  next case (CFG_IAdd C M pc)
    hence "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      and "Stack (stkLength (P, C, M) pc - 2)  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack)+
    with use_Eq CFG_IAdd show ?thesis by (auto elim!: Def.cases)
  next case (CFG_CmpEq C  M pc)
    hence "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      and "Stack (stkLength (P, C, M) pc - 2)  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack)+
    with use_Eq CFG_CmpEq show ?thesis by (auto elim!: Def.cases)
  next case CFG_New_Update
    hence "Heap  Use P (sourcenode a)" by (fastforce intro: Use_Normal_Heap)
    with use_Eq CFG_New_Update show ?thesis by (fastforce elim: Def.cases)
  next case (CFG_Getfield_Update C  M pc)
    hence "Heap  Use P (sourcenode a)"
      and "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      by (fastforce intro: Use_Normal_Heap Use_Normal_Stack)+
    with use_Eq CFG_Getfield_Update show ?thesis by (auto elim!: Def.cases split: prod.split)
  next case (CFG_Putfield_Update C  M pc)
    hence "Heap  Use P (sourcenode a)"
      and "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      and "Stack (stkLength (P, C, M) pc - 2)  Use P (sourcenode a)"
      by (fastforce intro: Use_Normal_Heap Use_Normal_Stack)+
    with use_Eq CFG_Putfield_Update show ?thesis by (auto elim!: Def.cases split: prod.split)
  next case (CFG_Throw_prop C  M pc)
    hence "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      by (fastforce intro: Use_Exceptional_Stack)
    with use_Eq CFG_Throw_prop show ?thesis by (fastforce elim: Def.cases)
  next case (CFG_Throw_handle C  M pc)
    hence "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      by (fastforce intro: Use_Exceptional_Stack)
    with use_Eq CFG_Throw_handle show ?thesis by (fastforce elim: Def.cases)
  next case CFG_Invoke_Call with ik show ?thesis by (simp add: intra_kind_def)
  next case CFG_Invoke_Return_Check_Normal with use_Eq show ?thesis
      by (fastforce elim: Def.cases intro: Use_Return_Heap Use_Return_Exception Use_Return_Stack)
  next case CFG_Invoke_Return_Check_Exceptional with use_Eq show ?thesis
      by (fastforce elim: Def.cases intro: Use_Return_Heap Use_Return_Exception Use_Return_Stack)
  next case CFG_Invoke_Return_Exceptional_handle with use_Eq show ?thesis
      by (fastforce elim: Def.cases intro: Use_Exceptional_Exception)
  next case CFG_Invoke_Return_Exceptional_prop with use_Eq show ?thesis
      by (fastforce elim: Def.cases intro: Use_Return_Heap Use_Return_Exception Use_Return_Stack)
  next case CFG_Return with use_Eq show ?thesis
      by (fastforce elim!: Def.cases intro: Use_Enter_Stack)
  next case CFG_Return_from_Method with ik show ?thesis by (simp add: intra_kind_def)
  qed (fastforce elim: Def.cases)+
next
  fix a s s'
  assume ve: "valid_edge (P, C0, Main) a"
    and pred: "JVMCFG_Interpret.pred (kind a) s"
    and "snd (hd s) = snd (hd s')"
    and use_Eq: "VUse P (sourcenode a).
           JVMCFG_Interpret.state_val s V = JVMCFG_Interpret.state_val s' V"
    and "length s = length s'"
  then obtain cfs C M pc cs cfs' cs' where [simp]: "s = (cfs, (C, M, pc)) # cs"
    and [simp]: "s' = (cfs', (C, M, pc)) # cs'" and length_cs: "length cs = length cs'"
    by (cases s, fastforce) (cases s', fastforce+)
  from ve pred show "JVMCFG_Interpret.pred (kind a) s'"
    unfolding valid_edge_def
  proof cases
    case Main_Call_LFalse with pred show ?thesis by simp
  next case Main_Call with pred use_Eq show ?thesis by simp
  next case Method_LTrue with pred use_Eq show ?thesis by simp
  next case CFG_Goto with pred use_Eq show ?thesis by simp
  next case (CFG_IfFalse_False C  M pc)
    hence "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack)
    with use_Eq CFG_IfFalse_False pred show ?thesis by fastforce
  next case (CFG_IfFalse_True C  M pc)
    hence "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack)
    with pred use_Eq CFG_IfFalse_True show ?thesis by fastforce
  next case CFG_New_Check_Normal
    hence "Heap  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Heap)
    with pred use_Eq CFG_New_Check_Normal show ?thesis by fastforce
  next case CFG_New_Check_Exceptional 
    hence "Heap  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Heap)
    with pred use_Eq CFG_New_Check_Exceptional show ?thesis by fastforce
  next case (CFG_Getfield_Check_Normal C  M pc)
    hence "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack)
    with pred use_Eq CFG_Getfield_Check_Normal show ?thesis by fastforce
  next case (CFG_Getfield_Check_Exceptional C  M pc)
    hence "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack)
    with pred use_Eq CFG_Getfield_Check_Exceptional  show ?thesis by fastforce
  next case (CFG_Putfield_Check_Normal C  M pc)
    hence "Stack (stkLength (P, C, M) pc - 2)  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack)
    with pred use_Eq CFG_Putfield_Check_Normal show ?thesis by fastforce
  next case (CFG_Putfield_Check_Exceptional C  M pc)
    hence "Stack (stkLength (P, C, M) pc - 2)  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack)
    with pred use_Eq CFG_Putfield_Check_Exceptional show ?thesis by fastforce
  next case (CFG_Checkcast_Check_Normal C  M pc)
    hence "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      and "Heap  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack Use_Enter_Heap)+
    with pred use_Eq CFG_Checkcast_Check_Normal show ?thesis by fastforce
  next case (CFG_Checkcast_Check_Exceptional C  M pc)
    hence "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      and "Heap  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack Use_Enter_Heap)+
    with pred use_Eq CFG_Checkcast_Check_Exceptional show ?thesis by fastforce
  next case (CFG_Throw_Check C  M pc)
    hence "Stack (stkLength (P, C, M) pc - 1)  Use P (sourcenode a)"
      and "Heap  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack Use_Enter_Heap)+
    with pred use_Eq CFG_Throw_Check show ?thesis by fastforce
  next case (CFG_Invoke_Check_NP_Normal C  M pc M' n)
    hence "Stack (stkLength (P, C, M) pc - (Suc n))  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack)
    with pred use_Eq CFG_Invoke_Check_NP_Normal show ?thesis by fastforce
  next case (CFG_Invoke_Check_NP_Exceptional C  M pc M' n)
    hence "Stack (stkLength (P, C, M) pc - (Suc n))  Use P (sourcenode a)"
      by (fastforce intro: Use_Enter_Stack)
    with pred use_Eq CFG_Invoke_Check_NP_Exceptional show ?thesis by fastforce
  next case (CFG_Invoke_Call C  M pc M' n)
    hence "Stack (stkLength (P, C, M) pc - (Suc n))  Use P (sourcenode a)"
      and "Heap  Use P (sourcenode a)"
      by (fastforce intro: Use_Normal_Heap Use_Normal_Stack)+
    with pred use_Eq CFG_Invoke_Call show ?thesis by fastforce
  next case CFG_Invoke_Return_Check_Normal
    hence "Exception  Use P (sourcenode a)"
      by (fastforce intro: Use_Return_Exception)
    with pred use_Eq CFG_Invoke_Return_Check_Normal show ?thesis by fastforce
  next case CFG_Invoke_Return_Check_Exceptional
    hence "Exception  Use P (sourcenode a)" and "Heap  Use P (sourcenode a)"
      by (fastforce intro: Use_Return_Exception Use_Return_Heap)+
    with pred use_Eq CFG_Invoke_Return_Check_Exceptional show ?thesis by fastforce
  next case CFG_Invoke_Return_Exceptional_prop
    hence "Exception  Use P (sourcenode a)" and "Heap  Use P (sourcenode a)"
      by (fastforce intro: Use_Return_Exception Use_Return_Heap)+
    with pred use_Eq CFG_Invoke_Return_Exceptional_prop show ?thesis by fastforce
  next case CFG_Return_from_Method with pred length_cs show ?thesis by clarsimp
  qed auto
next
  fix a Q r p fs ins outs
  assume "valid_edge (P, C0, Main) a"
    and kind: "kind a = Q:rpfs"
    and params: "(p, ins, outs)  set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
  thus "length fs = length ins" unfolding valid_edge_def
  proof cases
    case (Main_Call  T mxs mxl0 "is" xt D)
    with kind params have [simp]: "p = (D, Main)"
      and "PROG P  D sees Main: []T = (mxs, mxl0, is, xt) in D"
      and "ins = Heap # map Local [0..<Suc 0]"
      by (auto elim!: in_set_procsE dest: sees_method_fun sees_method_idemp)
    with Main_Call kind show ?thesis
      by auto
  next
    case (CFG_Invoke_Call C  M pc M' n ST LT D' Ts T mxs mxl0 "is" xt D)
    with kind params have [simp]: "p = (D, M')"
      and "PROG P  D' sees M': TsT = (mxs, mxl0, is, xt) in D"
      and "ins = Heap # map Local [0..<Suc (length Ts)]"
      by (auto elim!: in_set_procsE dest: sees_method_fun sees_method_idemp)
    moreover with (P, C0, Main)  (C, M, pc, Normal) C  ClassMain P
      ‹instrs_of (PROG P) C M ! pc = Invoke M' n ‹TYPING P C M ! pc = (ST, LT)
      ST ! n = Class D' have "n = length Ts"
      by (fastforce dest!: reachable_node_impl_wt_instr dest: sees_method_fun list_all2_lengthD)
    ultimately show ?thesis using CFG_Invoke_Call kind by auto
  qed simp_all
next
  fix a Q r p fs a' Q' r' p' fs' s s'
  assume ve_a: "valid_edge (P, C0, Main) a"
    and kind_a: "kind a = Q:rpfs"
    and ve_a': "valid_edge (P, C0, Main) a'"
    and kind_a': "kind a' = Q':r'p'fs'"
    and src: "sourcenode a = sourcenode a'"
    and pred_s: "JVMCFG_Interpret.pred (kind a) s"
    and pred_s': "JVMCFG_Interpret.pred (kind a') s"
  then obtain cfs C M pc cs cfs' C' M' pc' cs' 
    where [simp]: "s = (cfs, (C, M, pc)) # cs" 
    by (cases s) fastforce+
  with ve_a kind_a show "a = a'" unfolding valid_edge_def
  proof cases
    case Main_Call with ve_a' kind_a' src pred_s pred_s' show ?thesis unfolding valid_edge_def
      by (cases a, cases a') (fastforce elim: JVMCFG.cases dest: sees_method_fun)
  next
    case CFG_Invoke_Call
    note invoke_call1 = this
    from ve_a' kind_a' show ?thesis unfolding valid_edge_def
    proof cases
      case Main_Call with CFG_Invoke_Call src have False by simp
      thus ?thesis by simp
    next
      case CFG_Invoke_Call with src invoke_call1 show ?thesis
        by clarsimp (cases a, cases a', fastforce dest: sees_method_fun)
    qed simp_all
  qed simp_all
next
  fix a Q r p fs i ins outs s s'
  assume ve: "valid_edge (P, C0, Main) a"
    and kind: "kind a = Q:rpfs"
    and "i < length ins"
    and "(p, ins, outs)  set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
    and "JVMCFG_Interpret.pred (kind a) s"
    and "JVMCFG_Interpret.pred (kind a) s'"
    and use_Eq: "VParamUses P (sourcenode a) ! i.
           JVMCFG_Interpret.state_val s V = JVMCFG_Interpret.state_val s' V"
  then obtain cfs C M pc cs cfs' C' M' pc' cs' where [simp]: "s = (cfs, (C, M, pc)) # cs"
    and [simp]: "s' = (cfs', (C', M', pc')) # cs'"
    by (cases s, fastforce) (cases s', fastforce+)
  from ve kind
  show "JVMCFG_Interpret.params fs (JVMCFG_Interpret.state_val s) ! i =
          JVMCFG_Interpret.params fs (JVMCFG_Interpret.state_val s') ! i"
    unfolding valid_edge_def
  proof cases
    case Main_Call with kind use_Eq i < length ins show ?thesis
      by (cases i) auto
  next
    case CFG_Invoke_Call
    { fix P C M pc n st st' i
      have "Vrev (map (λn. {Stack (stkLength (P, C, M) pc - Suc n)}) [0..<n]) ! i. st V = st' V
         JVMCFG_Interpret.params
        (rev (map (λi s. s (Stack (stkLength (P, C, M) pc - Suc i))) [0..<n])) st ! i =
        JVMCFG_Interpret.params
        (rev (map (λi s. s (Stack (stkLength (P, C, M) pc - Suc i))) [0..<n])) st' ! i"
        by (induct n arbitrary: i) (simp, case_tac i, auto)
    }
    note stack_params = this
    from CFG_Invoke_Call kind use_Eq i < length ins show ?thesis
      by (cases i, auto) (case_tac nat, auto intro: stack_params)
  qed simp_all
next
  fix a Q' p f' ins outs vmap vmap'
  assume "valid_edge (P, C0, Main) a"
    and "kind a = Q'pf'"
    and "(p, ins, outs)  set (((ClassMain P, MethodMain P), [], []) # procs (PROG P))"
  thus "f' vmap vmap' = vmap'(ParamDefs P (targetnode a) [:=] map vmap outs)"
    unfolding valid_edge_def
    by (cases, simp_all) (fastforce elim: in_set_procsE simp: fun_upd_twist)
next
  fix a a'
  { fix P n f n' e n''
    assume "P  n -f n'" and "P  n -e n''"
    hence "e = f  n' = n''"
      by cases (simp_all, (fastforce elim: JVMCFG.cases)+)
  }
  note upd_det = this
  { fix P n Q n' Q' n'' s
    assume "P  n -(Q) n'" and edge': "P  n -(Q') n''" and trg: "n'  n''"
    hence "(Q s  ¬ Q' s)  (Q' s  ¬ Q s)"
    proof cases
      case CFG_Throw_Check with edge' trg show ?thesis by cases fastforce+
    qed (simp_all, (fastforce elim: JVMCFG.cases)+)
  }
  note pred_det = this
  assume "valid_edge (P, C0, Main) a"
    and ve': "valid_edge (P, C0, Main) a'"
    and src: "sourcenode a = sourcenode a'"
    and trg: "targetnode a  targetnode a'"
    and "intra_kind (kind a)"
    and "intra_kind (kind a')"
  thus "Q Q'. kind a = (Q)  kind a' = (Q')  (s. (Q s  ¬ Q' s)  (Q' s  ¬ Q s))"
    unfolding valid_edge_def intra_kind_def
    by (auto dest: upd_det pred_det)
qed

interpretation JVMCFGExit_wf :
  CFGExit_wf "sourcenode" "targetnode" "kind" "valid_edge (P, C0, Main)"
  "(ClassMain P, MethodMain P, None, Enter)"
  "(λ(C, M, pc, type). (C, M))" "get_return_edges P"
  "((ClassMain P, MethodMain P),[],[]) # procs (PROG P)"
  "(ClassMain P, MethodMain P)"
  "(ClassMain P, MethodMain P, None, Return)"
  "Def P" "Use P" "ParamDefs P" "ParamUses P"
proof
  show "Def P (ClassMain P, MethodMain P, None, nodeType.Return) = {} 
    Use P (ClassMain P, MethodMain P, None, nodeType.Return) = {}"
    by (fastforce elim: Def.cases Use.cases)
qed

end

Theory JVMPostdomination

theory JVMPostdomination imports JVMInterpretation "../StaticInter/Postdomination" begin

context CFG begin

lemma vp_snocI:
  "n -as* n'; n' -[a]→* n''; Q p ret fs. kind a  Qpret   n -as @ [a]* n''"
  by (cases "kind a") (auto intro: path_Append valid_path_aux_Append simp: vp_def valid_path_def)

lemma valid_node_cases' [case_names Source Target, consumes 1]:
  " valid_node n; e.  valid_edge e; sourcenode e = n   thesis;
  e.  valid_edge e; targetnode e = n   thesis 
   thesis"
  by (auto simp: valid_node_def)

end

lemma disjE_strong: "P  Q; P  R; Q; ¬ P  R  R"
  by auto

lemmas path_intros [intro] = JVMCFG_Interpret.path.Cons_path JVMCFG_Interpret.path.empty_path
declare JVMCFG_Interpret.vp_snocI [intro]
declare JVMCFG_Interpret.valid_node_def [simp add]
  valid_edge_def [simp add]
  JVMCFG_Interpret.intra_path_def [simp add]

abbreviation vp_snoc :: "wf_jvmprog  cname  mname  cfg_edge list  cfg_node
   (var, val, cname × mname × pc, cname × mname) edge_kind  cfg_node  bool"
  where "vp_snoc P C0 Main as n ek n'
   JVMCFG_Interpret.valid_path' P C0 Main
  (ClassMain P, MethodMain P, None, Enter) (as @ [(n,ek,n')]) n'"

lemma
  "(P, C0, Main)  (C, M, pc, nt) -ek (C', M', pc', nt')
   (as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
  (get_return_edges P) (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, nt)) 
  (as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
  (get_return_edges P) (ClassMain P, MethodMain P, None, Enter) as (C', M', pc', nt'))"
  and valid_Entry_path: "(P, C0, Main)  (C, M, pc, nt)
   as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
  (get_return_edges P) (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, nt)"
proof (induct rule: JVMCFG_reachable_inducts)
  case (Entry_reachable P C0 Main)
  hence "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) [] (ClassMain P, MethodMain P, None, Enter)"
    by (fastforce intro: JVMCFG_Interpret.intra_path_vp Method_LTrue
      JVMCFG_reachable.Entry_reachable)
  thus ?case by blast
next
  case (reachable_step P C0 Main C M pc nt ek C' M' pc' nt')
  thus ?case by simp
next
  case (Main_to_Call P C0 Main)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, 0, Enter)"
    by blast
  moreover with (P, C0, Main)  (ClassMain P, MethodMain P, 0, Enter)
  have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, 0, Enter) id
    (ClassMain P, MethodMain P, 0, Normal)"
    by (fastforce intro: JVMCFG_reachable.Main_to_Call)
  ultimately show ?case by blast
next
  case (Main_Call_LFalse P C0 Main)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, 0, Normal)"
    by blast
  moreover with (P, C0, Main)  (ClassMain P, MethodMain P, 0, Normal)
  have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, 0, Normal) (λs. False)
    (ClassMain P, MethodMain P, 0, Return)"
    by (fastforce intro: JVMCFG_reachable.Main_Call_LFalse)
  ultimately show ?case by blast
next
  case (Main_Call P C0 Main T mxs mxl0 "is" xt D initParams ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, 0, Normal)"
    by blast
  moreover with (P, C0, Main)  (ClassMain P, MethodMain P, 0, Normal)
    ‹PROG P  C0 sees Main: []T = (mxs, mxl0, is, xt) in D
    initParams = [λs. s Heap, λs. Value Null]
    ek = λ(s, ret). True:(ClassMain P, MethodMain P, 0)(D, Main)initParams
  have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, 0, Normal)
    ((λ(s, ret). True):(ClassMain P, MethodMain P, 0)(D, Main)[(λs. s Heap),(λs. Value Null)])
    (D, Main, None, Enter)"
    by (fastforce intro: JVMCFG_reachable.Main_Call)
  ultimately show ?case by blast
next
  case (Main_Return_to_Exit P C0 Main)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, 0, nodeType.Return)"
    by blast
  moreover with (P, C0, Main)  (ClassMain P, MethodMain P, 0, nodeType.Return)
  have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, 0, nodeType.Return) id
    (ClassMain P, MethodMain P, None, nodeType.Return)"
    by (fastforce intro: JVMCFG_reachable.Main_Return_to_Exit)
  ultimately show ?case by blast
next
  case (Method_LFalse P C0 Main C M)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, None, Enter)"
    by blast
  moreover with (P, C0, Main)  (C, M, None, Enter)
  have "vp_snoc P C0 Main as (C, M, None, Enter) (λs. False) (C, M, None, Return)"
    by (fastforce intro: JVMCFG_reachable.Method_LFalse)
  ultimately show ?case by blast
next
  case (Method_LTrue P C0 Main C M)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, None, Enter)"
    by blast
  moreover with (P, C0, Main)  (C, M, None, Enter)
  have "vp_snoc P C0 Main as (C, M, None, Enter) (λs. True) (C, M, 0, Enter)"
    by (fastforce intro: JVMCFG_reachable.Method_LTrue)
  ultimately show ?case by blast
next
  case (CFG_Load C P C0 Main M pc n ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Load n
    ek = λs. s(Stack (stkLength (P, C, M) pc) := s (Local n))
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, Suc pc, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Load)
  ultimately show ?case by blast
next
  case (CFG_Store C P C0 Main M pc n ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Store n
    ek = λs. s(Local n := s (Stack (stkLength (P, C, M) pc - 1)))
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, Suc pc, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Store)
  ultimately show ?case by blast
next
  case (CFG_Push C P C0 Main M pc v ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Push v
    ek = λs. s(Stack (stkLength (P, C, M) pc)  Value v)
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, Suc pc, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Push)
  ultimately show ?case by blast
next
  case (CFG_Pop C P C0 Main M pc ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Pop› ek = id›
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, Suc pc, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Pop)
  ultimately show ?case by blast
next
  case (CFG_IAdd C P C0 Main M pc ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = IAdd›
    ek = λs. let i1 = the_Intg (stkAt s (stkLength (P, C, M) pc - 1));
                   i2 = the_Intg (stkAt s (stkLength (P, C, M) pc - 2))
    in s(Stack (stkLength (P, C, M) pc - 2)  Value (Intg (i1 + i2)))
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, Suc pc, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_IAdd)
  ultimately show ?case by blast
next
  case (CFG_Goto C P C0 Main M pc i)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Goto i
  have "vp_snoc P C0 Main as (C, M, pc, Enter) (λs. True) (C, M, nat (int pc + i), Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Goto)
  ultimately show ?case by blast
next
  case (CFG_CmpEq C P C0 Main M pc ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = CmpEq›
    ek = λs. let e1 = stkAt s (stkLength (P, C, M) pc - 1);
                   e2 = stkAt s (stkLength (P, C, M) pc - 2)
    in s(Stack (stkLength (P, C, M) pc - 2)  Value (Bool (e1 = e2)))
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, Suc pc, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_CmpEq)
  ultimately show ?case by blast
next
  case (CFG_IfFalse_False C P C0 Main M pc i ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = IfFalse i i  1
    ek = (λs. stkAt s (stkLength (P, C, M) pc - 1) = Bool False)
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, nat (int pc + i), Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_IfFalse_False)
  ultimately show ?case by blast
next
  case (CFG_IfFalse_True C P C0 Main M pc i ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = IfFalse i
    ek = (λs. stkAt s (stkLength (P, C, M) pc - 1)  Bool False  i = 1)
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, Suc pc, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_IfFalse_True)
  ultimately show ?case by blast
next
  case (CFG_New_Check_Normal C P C0 Main M pc Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = New Cl ek = (λs. new_Addr (heap_of s)  None)
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, pc, Normal)"
    by (fastforce intro: JVMCFG_reachable.CFG_New_Check_Normal)
  ultimately show ?case by blast
next
  case (CFG_New_Check_Exceptional C P C0 Main M pc Cl pc' ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹ instrs_of (PROG P) C M ! pc = New Cl
    pc' = (case match_ex_table (PROG P) OutOfMemory pc (ex_table_of (PROG P) C M) of None  None
    | (pc'', d)  pc'') ek = (λs. new_Addr (heap_of s) = None)
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, pc, Exceptional pc' Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_New_Check_Exceptional)
  ultimately show ?case by blast
next
  case (CFG_New_Update C P C0 Main M pc Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Normal)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Normal)
    ‹ instrs_of (PROG P) C M ! pc = New Cl
    ek = λs. let a = the (new_Addr (heap_of s)) in
    s(Heap  Hp (heap_of s(a  blank (PROG P) Cl)),
      Stack (stkLength (P, C, M) pc)  Value (Addr a))
  have "vp_snoc P C0 Main as (C, M, pc, Normal) ek (C, M, Suc pc, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_New_Update)
  ultimately show ?case by blast
next
  case (CFG_New_Exceptional_prop C P C0 Main M pc Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional None Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional None Enter)
    ‹instrs_of (PROG P) C M ! pc = New Cl
    ek = λs. s(Exception  Value (Addr (addr_of_sys_xcpt OutOfMemory)))
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional None Enter) ek (C, M, None, Return)"
    by (fastforce intro: JVMCFG_reachable.CFG_New_Exceptional_prop)
  ultimately show ?case by blast
next
  case (CFG_New_Exceptional_handle C P C0 Main M pc pc' Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional pc' Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional pc' Enter)
    ‹instrs_of (PROG P) C M ! pc = New Cl
    ek = λs. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) 
    Value (Addr (addr_of_sys_xcpt OutOfMemory)))
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional pc' Enter) ek (C, M, pc', Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_New_Exceptional_handle)
  ultimately show ?case by blast
next
  case (CFG_Getfield_Check_Normal C P C0 Main M pc F Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Getfield F Cl
    ek = (λs. stkAt s (stkLength (P, C, M) pc - 1)  Null)
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, pc, Normal)"
    by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Check_Normal)
  ultimately show ?case by blast
next
  case (CFG_Getfield_Check_Exceptional C P C0 Main M pc F Cl pc' ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Getfield F Cl
    pc' = (case match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) of None  None
    | (pc'', d)  pc'') ek = (λs. stkAt s (stkLength (P, C, M) pc - 1) = Null)
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, pc, Exceptional pc' Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Check_Exceptional)
  ultimately show ?case by blast
next
  case (CFG_Getfield_Update C P C0 Main M pc F Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Normal)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Normal)
    ‹instrs_of (PROG P) C M ! pc = Getfield F Cl
    ek = λs. let (D, fs) = the (heap_of s (the_Addr (stkAt s (stkLength (P, C, M) pc - 1))))
    in s(Stack (stkLength (P, C, M) pc - 1)  Value (the (fs (F, Cl))))
  have "vp_snoc P C0 Main as (C, M, pc, Normal) ek (C, M, Suc pc, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Update)
  ultimately show ?case by blast
next
  case (CFG_Getfield_Exceptional_prop C P C0 Main M pc F Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional None Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional None Enter)
    ‹instrs_of (PROG P) C M ! pc = Getfield F Cl
    ek = λs. s(Exception  Value (Addr (addr_of_sys_xcpt NullPointer)))
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional None Enter) ek (C, M, None, Return)"
    by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Exceptional_prop)
  ultimately show ?case by blast
next
  case (CFG_Getfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional pc' Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional pc' Enter)
    ‹instrs_of (PROG P) C M ! pc = Getfield F Cl
    ek = λs. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) 
    Value (Addr (addr_of_sys_xcpt NullPointer)))
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional pc' Enter) ek (C, M, pc', Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Getfield_Exceptional_handle)
  ultimately show ?case by blast
next
  case (CFG_Putfield_Check_Normal C P C0 Main M pc F Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Putfield F Cl
    ek = (λs. stkAt s (stkLength (P, C, M) pc - 2)  Null)
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, pc, Normal)"
    by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Check_Normal)
  ultimately show ?case by blast
next
  case (CFG_Putfield_Check_Exceptional C P C0 Main M pc F Cl pc' ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Putfield F Cl
    pc' = (case match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) of None  None
    | (pc'', d)  pc'') ek = (λs. stkAt s (stkLength (P, C, M) pc - 2) = Null)
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, pc, Exceptional pc' Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Check_Exceptional)
  ultimately show ?case by blast
next
  case (CFG_Putfield_Update C P C0 Main M pc F Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Normal)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Normal)
    ‹instrs_of (PROG P) C M ! pc = Putfield F Cl
    ek = λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
    r = stkAt s (stkLength (P, C, M) pc - 2);
    a = the_Addr r; (D, fs) = the (heap_of s a); h' = heap_of s(a  (D, fs((F, Cl)  v)))
    in s(Heap  Hp h')
  have "vp_snoc P C0 Main as (C, M, pc, Normal) ek (C, M, Suc pc, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Update)
  ultimately show ?case by blast
next
  case (CFG_Putfield_Exceptional_prop C P C0 Main M pc F Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional None Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional None Enter)
    ‹instrs_of (PROG P) C M ! pc = Putfield F Cl
    ek = λs. s(Exception  Value (Addr (addr_of_sys_xcpt NullPointer)))
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional None Enter) ek (C, M, None, Return)"
    by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Exceptional_prop)
  ultimately show ?case by blast
next
  case (CFG_Putfield_Exceptional_handle C P C0 Main M pc pc' F Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional pc' Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional pc' Enter)
    ‹instrs_of (PROG P) C M ! pc = Putfield F Cl
    ek = λs. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) 
    Value (Addr (addr_of_sys_xcpt NullPointer)))
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional pc' Enter) ek (C, M, pc', Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Putfield_Exceptional_handle)
  ultimately show ?case by blast
next
  case (CFG_Checkcast_Check_Normal C P C0 Main M pc Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Checkcast Cl
    ek = (λs. cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1)))
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, Suc pc, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Checkcast_Check_Normal)
  ultimately show ?case by blast
next
  case (CFG_Checkcast_Check_Exceptional C P C0 Main M pc Cl pc' ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Checkcast Cl
    pc' = (case match_ex_table (PROG P) ClassCast pc (ex_table_of (PROG P) C M) of None  None
    | (pc'', d)  pc'')
    ek = (λs. ¬ cast_ok (PROG P) Cl (heap_of s) (stkAt s (stkLength (P, C, M) pc - 1)))
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, pc, Exceptional pc' Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Checkcast_Check_Exceptional)
  ultimately show ?case by blast
next
  case (CFG_Checkcast_Exceptional_prop C P C0 Main M pc Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional None Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional None Enter)
    ‹instrs_of (PROG P) C M ! pc = Checkcast Cl
    ek = λs. s(Exception  Value (Addr (addr_of_sys_xcpt ClassCast)))
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional None Enter) ek (C, M, None, Return)"
    by (fastforce intro: JVMCFG_reachable.CFG_Checkcast_Exceptional_prop)
  ultimately show ?case by blast
next
  case (CFG_Checkcast_Exceptional_handle C P C0 Main M pc pc' Cl ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional pc' Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional pc' Enter)
    ‹instrs_of (PROG P) C M ! pc = Checkcast Cl
    ek = λs. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) 
    Value (Addr (addr_of_sys_xcpt ClassCast)))
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional pc' Enter) ek (C, M, pc', Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Checkcast_Exceptional_handle)
  ultimately show ?case by blast
next
  case (CFG_Throw_Check C P C0 Main M pc pc' Exc d ek)
  then obtain as where path_src: "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  from pc' = None  match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = (the pc', d)
  show ?case
  proof (elim disjE_strong)
    assume "pc' = None"
    with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Throw›
    ek = (λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
           Cl = if v = Null then NullPointer else cname_of (heap_of s) (the_Addr v)
       in case pc' of None  match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
          | pc'' 
              d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = (pc'', d))
    have "(P, C0, Main)  (C, M, pc, Enter) -
      (λs. (stkAt s (stkLength (P, C, M) pc - Suc 0) = Null 
        match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) = None) 
        (stkAt s (stkLength (P, C, M) pc - Suc 0)  Null 
          match_ex_table (PROG P) (cname_of (heap_of s)
           (the_Addr (stkAt s (stkLength (P, C, M) pc - Suc 0)))) pc (ex_table_of (PROG P) C M) =
      None)) (C, M, pc, Exceptional None Enter)"
      by -(erule JVMCFG_reachable.CFG_Throw_Check, simp_all)
    with path_src pc' = None› ek = (λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
           Cl = if v = Null then NullPointer else cname_of (heap_of s) (the_Addr v)
       in case pc' of None  match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
          | pc'' 
              d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = (pc'', d))
    have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, pc, Exceptional None Enter)"
      by (fastforce intro: JVMCFG_reachable.CFG_Throw_Check)
    with path_src pc' = None› show ?thesis by blast
  next
    assume met: "match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = (the pc', d)"
      and pc': "pc'  None"
    with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Throw›
    ek = (λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
           Cl = if v = Null then NullPointer else cname_of (heap_of s) (the_Addr v)
       in case pc' of None  match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
          | pc'' 
              d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = (pc'', d))
    have "(P, C0, Main)  (C, M, pc, Enter) -
      (λs. (stkAt s (stkLength (P, C, M) pc - Suc 0) = Null 
                                    (d. match_ex_table (PROG P) NullPointer pc
                                          (ex_table_of (PROG P) C M) =
                                         (the pc', d))) 
                                   (stkAt s (stkLength (P, C, M) pc - Suc 0)  Null 
                                    (d. match_ex_table (PROG P)
                                          (cname_of (heap_of s)
                                            (the_Addr
                                              (stkAt s (stkLength (P, C, M) pc - Suc 0))))
                                          pc (ex_table_of (PROG P) C M) =
                                         (the pc', d))))
      (C, M, pc, Exceptional the pc' Enter)"
      by -(rule JVMCFG_reachable.CFG_Throw_Check, simp_all)
    with met pc' path_src ek = (λs. let v = stkAt s (stkLength (P, C, M) pc - 1);
           Cl = if v = Null then NullPointer else cname_of (heap_of s) (the_Addr v)
       in case pc' of None  match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = None
          | pc'' 
              d. match_ex_table (PROG P) Cl pc (ex_table_of (PROG P) C M) = (pc'', d))
    have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, pc, Exceptional pc' Enter)"
      by (fastforce intro: JVMCFG_reachable.CFG_Throw_Check)
    with path_src show ?thesis by blast
  qed
next
  case (CFG_Throw_prop C P C0 Main M pc ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional None Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional None Enter)
    ‹instrs_of (PROG P) C M ! pc = Throw›
    ek = λs. s(Exception  Value (stkAt s (stkLength (P, C, M) pc - 1)))
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional None Enter) ek (C, M, None, nodeType.Return)"
    by (fastforce intro: JVMCFG_reachable.CFG_Throw_prop)
  ultimately show ?case by blast
next
  case (CFG_Throw_handle C P C0 Main M pc pc' ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional pc' Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional pc' Enter)
    pc'  length (instrs_of (PROG P) C M) ‹instrs_of (PROG P) C M ! pc = Throw›
    ek = λs. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) 
    Value (stkAt s (stkLength (P, C, M) pc - 1)))
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional pc' Enter) ek (C, M, pc', Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Throw_handle)
  ultimately show ?case by blast
next
  case (CFG_Invoke_Check_NP_Normal C P C0 Main M pc M' n ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Invoke M' n 
    ek = (λs. stkAt s (stkLength (P, C, M) pc - Suc n)  Null)
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, pc, Normal)"
    by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Check_NP_Normal)
  ultimately show ?case by blast
next
  case (CFG_Invoke_Check_NP_Exceptional C P C0 Main M pc M' n pc' ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = Invoke M' n
    pc' = (case match_ex_table (PROG P) NullPointer pc (ex_table_of (PROG P) C M) of None  None
    | (pc'', d)  pc'')
    ek = (λs. stkAt s (stkLength (P, C, M) pc - Suc n) = Null)
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, pc, Exceptional pc' Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Check_NP_Exceptional)
  ultimately show ?case by blast
next
  case (CFG_Invoke_NP_prop C P C0 Main M pc M' n ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional None Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional None Enter)
    ‹instrs_of (PROG P) C M ! pc = Invoke M' n
    ek = λs. s(Exception  Value (Addr (addr_of_sys_xcpt NullPointer)))
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional None Enter) ek (C, M, None, Return)"
    by (fastforce intro: JVMCFG_reachable.CFG_Invoke_NP_prop)
  ultimately show ?case by blast
next
  case (CFG_Invoke_NP_handle C P C0 Main M pc pc' M' n ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional pc' Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional pc' Enter)
    ‹instrs_of (PROG P) C M ! pc = Invoke M' n
    ek = λs. s(Exception := None)(Stack (stkLength (P, C, M) pc' - 1) 
    Value (Addr (addr_of_sys_xcpt NullPointer)))
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional pc' Enter) ek (C, M, pc', Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Invoke_NP_handle)
  ultimately show ?case by blast
next
  case (CFG_Invoke_Call C P C0 Main M pc M' n ST LT D' Ts T mxs mxl0 "is" xt D Q paramDefs ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Normal)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Normal)
    ‹instrs_of (PROG P) C M ! pc = Invoke M' n ‹TYPING P C M ! pc = (ST, LT)
    ST ! n = Class D' ‹PROG P  D' sees M': TsT = (mxs, mxl0, is, xt) in D
    Q = (λ(s, ret). let r = stkAt s (stkLength (P, C, M) pc - Suc n);
              C' = cname_of (heap_of s) (the_Addr r) in D = fst (method (PROG P) C' M'))
    paramDefs = (λs. s Heap) # (λs. s (Stack (stkLength (P, C, M) pc - Suc n))) #
    rev (map (λi s. s (Stack (stkLength (P, C, M) pc - Suc i))) [0..<n])
    ek = Q:(C, M, pc)(D, M')paramDefs
  have "vp_snoc P C0 Main as (C, M, pc, Normal) ek (D, M', None, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Call)
  ultimately show ?case by blast
next
  case (CFG_Invoke_False C P C0 Main M pc M' n ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Normal)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Normal)
    ‹instrs_of (PROG P) C M ! pc = Invoke M' n ek = (λs. False)
  have "vp_snoc P C0 Main as (C, M, pc, Normal) ek (C, M, pc, Return)"
    by (fastforce intro: JVMCFG_reachable.CFG_Invoke_False)
  ultimately show ?case by blast
next
  case (CFG_Invoke_Return_Check_Normal C P C0 Main M pc M' n ST LT ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, nodeType.Return)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, nodeType.Return)
    ‹instrs_of (PROG P) C M ! pc = Invoke M' n ‹TYPING P C M ! pc = (ST, LT)
    ST ! n  NT› ek = (λs. s Exception = None)
  have "vp_snoc P C0 Main as (C, M, pc, Return) ek (C, M, Suc pc, Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Return_Check_Normal)
  ultimately show ?case by blast
next
  case (CFG_Invoke_Return_Check_Exceptional C P C0 Main M pc M' n Exc pc' diff ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, nodeType.Return)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, nodeType.Return)
    ‹instrs_of (PROG P) C M ! pc = Invoke M' n
    ‹match_ex_table (PROG P) Exc pc (ex_table_of (PROG P) C M) = (pc', diff)
    pc'  length (instrs_of (PROG P) C M)
    ek = (λs. v d. s Exception = v 
             match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc
              (ex_table_of (PROG P) C M) = (pc', d))
  have "vp_snoc P C0 Main as (C, M, pc, Return) ek (C, M, pc, Exceptional pc' Return)"
    by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Return_Check_Exceptional)
  ultimately show ?case by blast
next
  case (CFG_Invoke_Return_Exceptional_handle C P C0 Main M pc pc' M' n ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Exceptional pc' nodeType.Return)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Exceptional pc' nodeType.Return)
    ‹instrs_of (PROG P) C M ! pc = Invoke M' n
    ek = λs. s(Exception := None, Stack (stkLength (P, C, M) pc' - 1) := s Exception)
  have "vp_snoc P C0 Main as (C, M, pc, Exceptional pc' Return) ek (C, M, pc', Enter)"
    by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Return_Exceptional_handle)
  ultimately show ?case by blast
next
  case (CFG_Invoke_Return_Exceptional_prop C P C0 Main M pc M' n ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, nodeType.Return)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, nodeType.Return)
    ‹instrs_of (PROG P) C M ! pc = Invoke M' n
    ek = (λs. v. s Exception = v 
           match_ex_table (PROG P) (cname_of (heap_of s) (the_Addr (the_Value v))) pc
            (ex_table_of (PROG P) C M) = None)
  have "vp_snoc P C0 Main as (C, M, pc, Return) ek (C, M, None, Return)"
    by (fastforce intro: JVMCFG_reachable.CFG_Invoke_Return_Exceptional_prop)
  ultimately show ?case by blast
next
  case (CFG_Return C P C0 Main M pc ek)
  then obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
    (ClassMain P, MethodMain P, None, Enter) as (C, M, pc, Enter)"
    by blast
  moreover with C  ClassMain P (P, C0, Main)  (C, M, pc, Enter)
    ‹instrs_of (PROG P) C M ! pc = instr.Return›
    ek = λs. s(Stack 0 := s (Stack (stkLength (P, C, M) pc - 1)))
  have "vp_snoc P C0 Main as (C, M, pc, Enter) ek (C, M, None, Return)"
    by (fastforce intro: JVMCFG_reachable.CFG_Return)
  ultimately show ?case by blast
next
  case (CFG_Return_from_Method P C0 Main C M C' M' pc' Q' ps Q stateUpdate ek)
  from (P, C0, Main)  (C', M', pc', Normal) -Q':(C', M', pc')(C, M)ps (C, M, None, Enter)
  show ?case
  proof cases
    case Main_Call
    with CFG_Return_from_Method obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
      (ClassMain P, MethodMain P, None, Enter) as (ClassMain P, MethodMain P, 0, Normal)"
      by blast
    moreover with Main_Call have "vp_snoc P C0 Main as (ClassMain P, MethodMain P, 0, Normal)
      (λs. False) (ClassMain P, MethodMain P, 0, Return)"
      by (fastforce intro: Main_Call_LFalse)
    ultimately show ?thesis using Main_Call CFG_Return_from_Method by blast
  next
    case CFG_Invoke_Call
    with CFG_Return_from_Method obtain as where "JVMCFG_Interpret.valid_path' P C0 Main
      (ClassMain P, MethodMain P, None, Enter) as (C', M', pc', Normal)"
      by blast
    moreover with CFG_Invoke_Call
    have "vp_snoc P C0 Main as (C', M', pc', Normal) (λs. False) (C', M', pc', Return)"
      by (fastforce intro: CFG_Invoke_False)
    ultimately show ?thesis using CFG_Invoke_Call CFG_Return_from_Method by blast
  qed
qed

declare JVMCFG_Interpret.vp_snocI []
declare JVMCFG_Interpret.valid_node_def [simp del]
  valid_edge_def [simp del]
  JVMCFG_Interpret.intra_path_def [simp del]


definition EP :: jvm_prog
  where "EP = (''C'', Object, [],
  [(''M'', [], Void, 1::nat, 0::nat, [Push Unit, instr.Return], [])]) # SystemClasses"

definition Phi_EP :: tyP
  where "Phi_EP C M = (if C = ''C''  M = ''M''
      then [([],[OK (Class ''C'')]),([Void],[OK (Class ''C'')])] else [])"

lemma distinct_classes'':
  "''C''  Object"
  "''C''  NullPointer"
  "''C''  OutOfMemory"
  "''C''  ClassCast"
  by (simp_all add: Object_def NullPointer_def OutOfMemory_def ClassCast_def)

lemmas distinct_classes =
  distinct_classes distinct_classes'' distinct_classes'' [symmetric]
  
declare distinct_classes [simp add]

lemma i_max_2D: "i < Suc (Suc 0)  i = 0  i = 1" by auto

lemma EP_wf: "wf_jvm_progPhi_EP EP"
  unfolding wf_jvm_prog_phi_def wf_prog_def
proof
  show "wf_syscls EP"
    by (simp add: EP_def wf_syscls_def SystemClasses_def sys_xcpts_def
      ObjectC_def NullPointerC_def OutOfMemoryC_def ClassCastC_def)
next
  have distinct_EP: "distinct_fst EP"
    by (auto simp: EP_def SystemClasses_def ObjectC_def NullPointerC_def OutOfMemoryC_def
      ClassCastC_def)
  moreover have classes_wf:
    "cset EP. wf_cdecl
    (λP C (M, Ts, Tr, mxs, mxl0, is, xt). wt_method P C Ts Tr mxs mxl0 is xt (Phi_EP C M)) EP c"
  proof
    fix C
    assume C_in_EP: "C  set EP"
    show "wf_cdecl
      (λP C (M, Ts, Tr, mxs, mxl0, is, xt). wt_method P C Ts Tr mxs mxl0 is xt (Phi_EP C M)) EP C"
    proof (cases "C  set SystemClasses")
      case True
      thus ?thesis
        by (auto simp: wf_cdecl_def SystemClasses_def ObjectC_def NullPointerC_def
          OutOfMemoryC_def ClassCastC_def EP_def class_def)
    next
      case False
      with C_in_EP have "C = (''C'', the (class EP ''C''))"
        by (auto simp: EP_def SystemClasses_def class_def)
      thus ?thesis
        by (auto dest!: i_max_2D elim: Methods.cases
          simp: wf_cdecl_def class_def EP_def wf_mdecl_def wt_method_def Phi_EP_def
          wt_start_def check_types_def states_def JVM_SemiType.sl_def SystemClasses_def
          stk_esl_def upto_esl_def loc_sl_def SemiType.esl_def ObjectC_def
          SemiType.sup_def Err.sl_def Err.le_def err_def Listn.sl_def Method_def
          Err.esl_def Opt.esl_def Product.esl_def relevant_entries_def)
    qed
  qed
  ultimately show "(cset EP. wf_cdecl
    (λP C (M, Ts, Tr, mxs, mxl0, is, xt). wt_method P C Ts Tr mxs mxl0 is xt (Phi_EP C M)) EP c) 
    distinct_fst EP"
    by simp
qed

lemma [simp]: "PROG (Abs_wf_jvmprog (EP, Phi_EP)) = EP"
proof (cases "(EP, Phi_EP)  wf_jvmprog")
  case True thus ?thesis by (simp add: Abs_wf_jvmprog_inverse)
next
  case False with EP_wf show ?thesis by (simp add: wf_jvmprog_def)
qed

lemma [simp]: "TYPING (Abs_wf_jvmprog (EP, Phi_EP)) = Phi_EP"
proof (cases "(EP, Phi_EP)  wf_jvmprog")
  case True thus ?thesis by (simp add: Abs_wf_jvmprog_inverse)
next
  case False with EP_wf show ?thesis by (simp add: wf_jvmprog_def)
qed

lemma method_in_EP_is_M:
  "EP  C sees M: TsT = (mxs, mxl, is, xt) in D
   C = ''C''  M = ''M''  Ts = []  T = Void  mxs = 1  mxl = 0 
  is = [Push Unit, instr.Return]  xt = []  D = ''C''"
  by (fastforce elim: Methods.cases 
    simp: class_def SystemClasses_def ObjectC_def NullPointerC_def OutOfMemoryC_def ClassCastC_def
    if_split_eq1 EP_def Method_def)

lemma [simp]:
  "T Ts mxs mxl is. (xt. EP  ''C'' sees ''M'': TsT = (mxs, mxl, is, xt) in ''C'')  is  []"
  using EP_wf
  by (fastforce dest: mdecl_visible simp: wf_jvm_prog_phi_def EP_def)

lemma [simp]:
  "T Ts mxs mxl is. (xt. EP  ''C'' sees ''M'': TsT = (mxs, mxl, is, xt) in ''C'')  
  Suc 0 < length is"
  using EP_wf
  by (fastforce dest: mdecl_visible simp: wf_jvm_prog_phi_def EP_def)

lemma C_sees_M_in_EP [simp]:
  "EP  ''C'' sees ''M'': []Void = (Suc 0, 0, [Push Unit, instr.Return], []) in ''C''"
proof -
  have "EP  ''C'' sees_methods [''M''  (([], Void, 1, 0, [Push Unit, instr.Return], []), ''C'')]"
    by (fastforce intro: Methods.intros simp: class_def SystemClasses_def ObjectC_def EP_def)
  thus ?thesis by (fastforce simp: Method_def)
qed

lemma instrs_of_EP_C_M [simp]:
  "instrs_of EP ''C'' ''M'' = [Push Unit, instr.Return]"
  unfolding method_def
  by (rule theI2 [where P = "λ(D, Ts, T, m). EP  ''C'' sees ''M'': TsT = m in D"])
(auto dest: method_in_EP_is_M)

lemma ClassMain_not_C [simp]: "ClassMain (Abs_wf_jvmprog (EP, Phi_EP))  ''C''"
  by (fastforce intro: no_Call_in_ClassMain [where P="Abs_wf_jvmprog (EP, Phi_EP)"] C_sees_M_in_EP)

lemma method_entry [dest!]: "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')  (C, M, None, Enter)
   (C = ClassMain (Abs_wf_jvmprog (EP, Phi_EP))  M = MethodMain (Abs_wf_jvmprog (EP, Phi_EP)))
   (C = ''C''  M = ''M'')"
  by (fastforce elim: reachable.cases elim!: JVMCFG.cases dest!: method_in_EP_is_M)

lemma valid_node_in_EP_D:
  assumes vn: "JVMCFG_Interpret.valid_node (Abs_wf_jvmprog (EP, Phi_EP)) ''C'' ''M'' n"
  shows "n  {
  (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None, Enter),
  (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None, Return),
  (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), 0, Enter),
  (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), 0, Normal),
  (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), 0, Return),
  (''C'', ''M'', None, Enter),
  (''C'', ''M'', 0, Enter),
  (''C'', ''M'', 1, Enter),
  (''C'', ''M'', None, Return)
  }"
  using vn
proof (cases rule: JVMCFG_Interpret.valid_node_cases')
  let ?prog = "Abs_wf_jvmprog (EP, Phi_EP)"
  case (Source e)
  then obtain C M pc nt ek C' M' pc' nt'
    where [simp]: "e = ((C, M, pc, nt), ek, (C', M', pc', nt'))"
    and [simp]: "n = (C, M, pc, nt)"
    and edge: "(?prog, ''C'', ''M'')  (C, M, pc, nt) -ek (C', M', pc', nt')"
    by (cases e) (fastforce simp: valid_edge_def)
  from edge have src_reachable: "(?prog, ''C'', ''M'')  (C, M, pc, nt)"
    by -(drule sourcenode_reachable)
  show ?thesis
  proof (cases "C = ClassMain ?prog")
    case True
    with src_reachable have "M = MethodMain ?prog"
      by (fastforce dest: ClassMain_imp_MethodMain)
    with True edge show ?thesis
      by clarsimp (erule JVMCFG.cases, simp_all)
  next
    case False
    with src_reachable obtain T Ts mb where "EP  C sees M:TsT = mb in C"
      by (fastforce dest: method_of_reachable_node_exists)
    hence [simp]: "C = ''C''"
      and [simp]: "M = ''M''"
      and [simp]: "Ts = []"
      and [simp]: "T = Void"
      and [simp]: "mb = (1, 0, [Push Unit, instr.Return], [])"
      by (cases mb, fastforce dest: method_in_EP_is_M)+
    from src_reachable False have "pc  {None, 0, 1}"
      by (fastforce dest: instr_of_reachable_node_typable)
    show ?thesis
    proof (cases pc)
      case None
      with edge False show ?thesis
        by clarsimp (erule JVMCFG.cases, simp_all)
    next
      case (Some pc')
      show ?thesis
      proof (cases pc')
        case 0
        with Some False edge show ?thesis
          by clarsimp (erule JVMCFG.cases, fastforce+)
      next
        case (Suc n)
        with pc  {None, 0, 1} Some have "pc = 1"
          by simp
        with False edge show ?thesis
          by clarsimp (erule JVMCFG.cases, fastforce+)
      qed
    qed
  qed
next
  let ?prog = "Abs_wf_jvmprog (EP, Phi_EP)"
  case (Target e)
  then obtain C M pc nt ek C' M' pc' nt'
    where [simp]: "e = ((C, M, pc, nt), ek, (C', M', pc', nt'))"
    and [simp]: "n = (C', M', pc', nt')"
    and edge: "(?prog, ''C'', ''M'')  (C, M, pc, nt) -ek (C', M', pc', nt')"
    by (cases e) (fastforce simp: valid_edge_def)
  from edge have trg_reachable: "(?prog, ''C'', ''M'')  (C', M', pc', nt')"
    by -(drule targetnode_reachable)
  show ?thesis
  proof (cases "C' = ClassMain ?prog")
    case True
    with trg_reachable have "M' = MethodMain ?prog"
      by (fastforce dest: ClassMain_imp_MethodMain)
    with True edge show ?thesis
      by -(clarsimp, (erule JVMCFG.cases, simp_all))+
  next
    case False
    with trg_reachable obtain T Ts mb where "EP  C' sees M':TsT = mb in C'"
      by (fastforce dest: method_of_reachable_node_exists)
    hence [simp]: "C' = ''C''"
      and [simp]: "M' = ''M''"
      and [simp]: "Ts = []"
      and [simp]: "T = Void"
      and [simp]: "mb = (1, 0, [Push Unit, instr.Return], [])"
      by (cases mb, fastforce dest: method_in_EP_is_M)+
    from trg_reachable False have "pc'  {None, 0, 1}"
      by (fastforce dest: instr_of_reachable_node_typable)
    show ?thesis
    proof (cases pc')
      case None
      with edge False show ?thesis
        by clarsimp (erule JVMCFG.cases, simp_all)
    next
      case (Some pc'')
      show ?thesis
      proof (cases pc'')
        case 0
        with Some False edge show ?thesis
          by -(clarsimp, (erule JVMCFG.cases, fastforce+))+
      next
        case (Suc n)
        with pc'  {None, 0, 1} Some have "pc' = 1"
          by simp
        with False edge show ?thesis
          by -(clarsimp, (erule JVMCFG.cases, fastforce+))+
      qed
    qed
  qed
qed

lemma Main_Entry_valid [simp]:
  "JVMCFG_Interpret.valid_node (Abs_wf_jvmprog (EP, Phi_EP)) ''C'' ''M''
  (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None, Enter)"
proof -
  have "valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')
    ((ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None,
      Enter),
    (λs. False),
    (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)), None,
      Return))"
    by (auto simp: valid_edge_def intro: JVMCFG_reachable.intros)
  thus ?thesis by (fastforce simp: JVMCFG_Interpret.valid_node_def)
qed

lemma main_0_Enter_reachable [simp]: "(P, C0, Main)  (ClassMain P, MethodMain P, 0, Enter)"
  by (rule reachable_step [where n="(ClassMain P, MethodMain P, None, Enter)"])
(fastforce intro: JVMCFG_reachable.intros)+

lemma main_0_Normal_reachable [simp]: "(P, C0, Main)  (ClassMain P, MethodMain P, 0, Normal)"
  by (rule reachable_step [where n="(ClassMain P, MethodMain P, 0, Enter)"], simp)
(fastforce intro: JVMCFG_reachable.intros)

lemma main_0_Return_reachable [simp]: "(P, C0, Main)  (ClassMain P, MethodMain P, 0, Return)"
  by (rule reachable_step [where n="(ClassMain P, MethodMain P, 0, Normal)"], simp)
(fastforce intro: JVMCFG_reachable.intros)

lemma Exit_reachable [simp]: "(P, C0, Main)  (ClassMain P, MethodMain P, None, Return)"
  by (rule reachable_step [where n="(ClassMain P, MethodMain P, 0, Return)"], simp)
(fastforce intro: JVMCFG_reachable.intros)

definition
  "cfg_wf_prog =
    {(P, C0, Main). (n. JVMCFG_Interpret.valid_node P C0 Main n 
         (as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
                         (get_return_edges P) n as (ClassMain P, MethodMain P, None, Return)))}"

typedef cfg_wf_prog = cfg_wf_prog
  unfolding cfg_wf_prog_def
proof
  let ?prog = "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')"
  let ?edge_main0 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), None, Enter),
    (λs. False),
    (ClassMain (fst ?prog), MethodMain (fst ?prog), None, Return))"
  let ?edge_main1 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), None, Enter),
    (λs. True),
    (ClassMain (fst ?prog), MethodMain (fst ?prog), 0, Enter))"
  let ?edge_main2 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), 0, Enter),
    id,
    (ClassMain (fst ?prog), MethodMain (fst ?prog), 0, Normal))"
  let ?edge_main3 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), 0, Normal),
    (λs. False),
    (ClassMain (fst ?prog), MethodMain (fst ?prog), 0, Return))"
  let ?edge_main4 = "((ClassMain (fst ?prog), MethodMain (fst ?prog), 0, Return),
    id,
    (ClassMain (fst ?prog), MethodMain (fst ?prog), None, Return))"
  let ?edge_call = "((ClassMain (fst ?prog), MethodMain (fst ?prog), 0, Normal),
    ((λ(s, ret). True):(ClassMain (fst ?prog),
      MethodMain (fst ?prog), 0)(''C'', ''M'')[(λs. s Heap),(λs. Value Null)]),
    (''C'', ''M'', None, Enter))"
  let ?edge_C0 = "((''C'', ''M'', None, Enter),
    (λs. False),
    (''C'', ''M'', None, Return))"
  let ?edge_C1 = "((''C'', ''M'', None, Enter),
    (λs. True),
    (''C'', ''M'', 0, Enter))"
  let ?edge_C2 = "((''C'', ''M'', 0, Enter),
    (λs. s(Stack 0  Value Unit)),
    (''C'', ''M'', 1, Enter))"
  let ?edge_C3 = "((''C'', ''M'', 1, Enter),
    (λs. s(Stack 0 := s (Stack 0))),
    (''C'', ''M'', None, Return))"
  let ?edge_return = "((''C'', ''M'', None, Return),
    (λ(s, ret). ret = (ClassMain (fst ?prog),
      MethodMain (fst ?prog), 0))(''C'',''M'')(λs s'. s'(Heap := s Heap,
                            Exception := s Exception,
                            Stack 0 := s (Stack 0))),
    (ClassMain (fst ?prog), MethodMain (fst ?prog), 0, Return))"
  have [simp]:
    "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')  (''C'', ''M'', None, Enter)"
    by (rule reachable_step [where n="(ClassMain (fst ?prog), MethodMain (fst ?prog), 0, Normal)"]
      , simp)
  (fastforce intro: Main_Call C_sees_M_in_EP)
  hence [simp]:
    "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')  (''C'', ''M'', None, nodeType.Return)"
    by (rule reachable_step [where n="(''C'', ''M'', None, Enter)"])
  (fastforce intro: JVMCFG_reachable.intros)
  have [simp]:
    "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')  (''C'', ''M'', 0, Enter)"
    by (rule reachable_step [where n="(''C'', ''M'', None, Enter)"], simp)
  (fastforce intro: JVMCFG_reachable.intros)
  hence [simp]:
    "(Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')  (''C'', ''M'', Suc 0, Enter)"
    by (fastforce intro: reachable_step [where n="(''C'', ''M'', 0, Enter)"] CFG_Push
      simp: ClassMain_not_C [symmetric])
  show "?prog  {(P, C0, Main).
          n. CFG.valid_node sourcenode targetnode (valid_edge (P, C0, Main)) n 
              (as. CFG.valid_path' sourcenode targetnode kind (valid_edge (P, C0, Main))
                     (get_return_edges P) n as
                     (ClassMain P, MethodMain P, None, nodeType.Return))}"
  proof (auto dest!: valid_node_in_EP_D)
    have "CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           None, Enter)
          [?edge_main0]
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
              None, nodeType.Return)"
      by (fastforce intro: JVMCFG_Interpret.intra_path_vp JVMCFG_reachable.intros
        simp: JVMCFG_Interpret.intra_path_def intra_kind_def valid_edge_def)
    thus " as. CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           None, Enter)
          as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
              None, nodeType.Return)"
      by blast
  next
    have "CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           None, nodeType.Return)
      [] (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
              None, nodeType.Return)"
      by (fastforce intro: JVMCFG_Interpret.intra_path_vp simp: JVMCFG_Interpret.intra_path_def)
    thus "as. CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           None, nodeType.Return)
          as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
              None, nodeType.Return)"
      by blast
  next
    have "CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           0, Enter)
      [?edge_main2, ?edge_main3, ?edge_main4]
      (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
              None, nodeType.Return)"
      by (fastforce intro: JVMCFG_Interpret.intra_path_vp JVMCFG_reachable.intros
        simp: JVMCFG_Interpret.intra_path_def intra_kind_def valid_edge_def)
    thus "as. CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           0, Enter)
          as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
              None, nodeType.Return)"
      by blast
  next
    have "CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           0, Normal)
      [?edge_main3, ?edge_main4]
      (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
              None, nodeType.Return)"
      by (fastforce intro: JVMCFG_Interpret.intra_path_vp JVMCFG_reachable.intros
        simp: JVMCFG_Interpret.intra_path_def intra_kind_def valid_edge_def)
    thus "as. CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           0, Normal)
          as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
              None, nodeType.Return)"
      by blast
  next
    have "CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           0, nodeType.Return)
      [?edge_main4]
      (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
              None, nodeType.Return)"
      by (fastforce intro: JVMCFG_Interpret.intra_path_vp JVMCFG_reachable.intros
        simp: JVMCFG_Interpret.intra_path_def intra_kind_def valid_edge_def)
    thus "as. CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP)))
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           0, nodeType.Return)
          as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
              None, nodeType.Return)"
      by blast
  next
    have "CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', None, Enter)
      [?edge_C0, ?edge_return, ?edge_main4]
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           None, nodeType.Return)"
      by (fastforce intro: JVMCFG_reachable.intros C_sees_M_in_EP
        simp: JVMCFG_Interpret.vp_def valid_edge_def stkLength_def JVMCFG_Interpret.valid_path_def)
    thus "as. CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', None, Enter) as
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           None, nodeType.Return)"
      by blast
  next
    have "CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', 0, Enter)
      [?edge_C2, ?edge_C3, ?edge_return, ?edge_main4]
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           None, nodeType.Return)"
      by (fastforce intro: Main_Return_to_Exit CFG_Return_from_Method Main_Call
        C_sees_M_in_EP CFG_Return CFG_Push
        simp: JVMCFG_Interpret.vp_def valid_edge_def stkLength_def Phi_EP_def
        ClassMain_not_C [symmetric] JVMCFG_Interpret.valid_path_def)
    thus "as. CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', 0, Enter) as
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           None, nodeType.Return)"
      by blast
  next
    have "CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', Suc 0, Enter)
      [?edge_C3, ?edge_return, ?edge_main4]
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           None, nodeType.Return)"
      by (fastforce intro: JVMCFG_reachable.intros C_sees_M_in_EP
        simp: JVMCFG_Interpret.vp_def valid_edge_def stkLength_def Phi_EP_def
        ClassMain_not_C [symmetric] JVMCFG_Interpret.valid_path_def)
    thus "as. CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', Suc 0, Enter) as
          (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
           None, nodeType.Return)"
      by blast
  next
    have "CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', None, nodeType.Return)
          [?edge_return, ?edge_main4]
      (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
              None, nodeType.Return)"
      by (fastforce intro: JVMCFG_reachable.intros C_sees_M_in_EP
        simp: JVMCFG_Interpret.vp_def valid_edge_def JVMCFG_Interpret.valid_path_def stkLength_def)
    thus "as. CFG.valid_path' sourcenode targetnode kind
          (valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M''))
          (get_return_edges (Abs_wf_jvmprog (EP, Phi_EP))) (''C'', ''M'', None, nodeType.Return)
          as (ClassMain (Abs_wf_jvmprog (EP, Phi_EP)), MethodMain (Abs_wf_jvmprog (EP, Phi_EP)),
              None, nodeType.Return)"
      by blast
  qed
qed


abbreviation lift_to_cfg_wf_prog :: "(jvm_method  'a)  (cfg_wf_prog  'a)"
  ("_CFG")
  where "fCFG  (λP. f (Rep_cfg_wf_prog P))"

lemma valid_edge_CFG_def: "valid_edgeCFG P = valid_edge (fstCFG P, fst (sndCFG P), snd (sndCFG P))"
  by (cases P) (clarsimp simp: Abs_cfg_wf_prog_inverse)

interpretation JVMCFG_Postdomination:
  Postdomination "sourcenode" "targetnode" "kind" "valid_edgeCFG P"
  "(ClassMain (fstCFG P), MethodMain (fstCFG P), None, Enter)"
  "(λ(C, M, pc, type). (C, M))" "get_return_edges (fstCFG P)"
  "((ClassMain (fstCFG P), MethodMain (fstCFG P)),[],[]) # procs (PROG (fstCFG P))"
  "(ClassMain (fstCFG P), MethodMain (fstCFG P))"
  "(ClassMain (fstCFG P), MethodMain (fstCFG P), None, Return)"
  for P
  unfolding valid_edge_CFG_def
proof
  fix n
  obtain P' C0 Main where [simp]: "fstCFG P = P'" and [simp]: "fst (sndCFG P) = C0"
    and [simp]: "snd (sndCFG P) = Main"
    by (cases P) clarsimp
  assume "CFG.valid_node sourcenode targetnode
    (valid_edge (fstCFG P, fst (sndCFG P), snd (sndCFG P))) n"
  thus "as. CFG.valid_path' sourcenode targetnode kind
    (valid_edge (fstCFG P, fst (sndCFG P), snd (sndCFG P)))
    (get_return_edges (fstCFG P))
    (ClassMain (fstCFG P), MethodMain (fstCFG P), None, Enter) as n"
    by (auto dest: sourcenode_reachable targetnode_reachable valid_Entry_path
      simp: JVMCFG_Interpret.valid_node_def valid_edge_def)
next
  fix n
  obtain P' C0 Main where [simp]: "fstCFG P = P'" and [simp]: "fst (sndCFG P) = C0"
    and [simp]: "snd (sndCFG P) = Main"
    and "(P', C0, Main)  cfg_wf_prog"
    by (cases P) (clarsimp simp: Abs_cfg_wf_prog_inverse)
  assume "CFG.valid_node sourcenode targetnode
    (valid_edge (fstCFG P, fst (sndCFG P), snd (sndCFG P))) n"
  with (P', C0, Main)  cfg_wf_prog›
  show "as. CFG.valid_path' sourcenode targetnode kind
    (valid_edge (fstCFG P, fst (sndCFG P), snd (sndCFG P)))
    (get_return_edges (fstCFG P)) n as
    (ClassMain (fstCFG P), MethodMain (fstCFG P), None, nodeType.Return)"
    by (cases n) (fastforce simp: cfg_wf_prog_def)
next
  fix n n'
  obtain P' C0 Main where [simp]: "fstCFG P = P'" and [simp]: "fst (sndCFG P) = C0"
    and [simp]: "snd (sndCFG P) = Main"
    by (cases P) clarsimp
  assume "CFGExit.method_exit sourcenode kind
    (valid_edge (fstCFG P, fst (sndCFG P), snd (sndCFG P)))
    (ClassMain (fstCFG P), MethodMain (fstCFG P), None, nodeType.Return) n"
    and "CFGExit.method_exit sourcenode kind
    (valid_edge (fstCFG P, fst (sndCFG P), snd (sndCFG P)))
    (ClassMain (fstCFG P), MethodMain (fstCFG P), None, nodeType.Return) n'"
    and "(λ(C, M, pc, type). (C, M)) n = (λ(C, M, pc, type). (C, M)) n'"
  thus "n = n'"
    by (auto simp: JVMCFG_Exit_Interpret.method_exit_def valid_edge_def)
  (fastforce elim: JVMCFG.cases)+
qed

end

Theory JVMSDG

theory JVMSDG imports JVMCFG_wf JVMPostdomination "../StaticInter/SDG" begin

interpretation JVMCFGExit_wf_new_type:
  CFGExit_wf "sourcenode" "targetnode" "kind" "valid_edgeCFG P"
  "(ClassMain (fstCFG P), MethodMain (fstCFG P), None, Enter)"
  "(λ(C, M, pc, type). (C, M))" "get_return_edges (fstCFG P)"
  "((ClassMain (fstCFG P), MethodMain (fstCFG P)),[],[]) # procs (PROG (fstCFG P))"
  "(ClassMain (fstCFG P), MethodMain (fstCFG P))"
  "(ClassMain (fstCFG P), MethodMain (fstCFG P), None, Return)"
  "Def (fstCFG P)" "Use (fstCFG P)" "ParamDefs (fstCFG P)" "ParamUses (fstCFG P)"
  for P
  unfolding valid_edge_CFG_def
  ..

interpretation JVM_SDG :
  SDG "sourcenode" "targetnode" "kind" "valid_edgeCFG P"
  "(ClassMain (fstCFG P), MethodMain (fstCFG P), None, Enter)"
  "(λ(C, M, pc, type). (C, M))" "get_return_edges (fstCFG P)"
  "((ClassMain (fstCFG P), MethodMain (fstCFG P)),[],[]) # procs (PROG (fstCFG P))"
  "(ClassMain (fstCFG P), MethodMain (fstCFG P))"
  "(ClassMain (fstCFG P), MethodMain (fstCFG P), None, Return)"
  "Def (fstCFG P)" "Use (fstCFG P)" "ParamDefs (fstCFG P)" "ParamUses (fstCFG P)"
  for P
  ..

end